      PROGRAM BUDPLOT                                                                                                               
C     PROGRAM BUDPLOT (I1,        I2,       I3,                                 A2                                                  
C                      I4,        I5,       I6,                                 A2                                                  
C                                 I7,       I8,                                 A2                                                  
C                           INPUT,      OUTPUT,                         )       A2                                                  
C    1          TAPE11=I1, TAPE12=I2, TAPE13=I3,                                                                                    
C    2          TAPE14=I4, TAPE15=I5, TAPE16=I6,                                                                                    
C    3                     TAPE17=I7, TAPE18=I8,                                                                                    
C                     TAPE5=INPUT, TAPE6=OUTPUT)                                                                                    
C     ------------------------------------------                                A2                                                  
C                                                                               A2                                                  
C     AUG 23/07 - B.MIVILLE - UPDATED LOOK OF DIAGRAM                           A2                                                  
C     MAR 30/96 - F.ZWIERS, T. GUI.                                             A2                                                  
C                                                                               A2                                                  
CBUDPLOT - BUDGET PLOTS BASED ON 8 GLOBAVG INPUT VALUES                 8  1 C  A1                                                  
C                                                                               A3                                                  
CAUTHORS - F.ZWIERS, T. GUI                                                     A3                                                  
C                                                                               A3                                                  
CPURPOSE - READ 8 CCRN STANDARD BINARY FILES OF GLOBAVG BUDGET VALUES           A3                                                  
C          AND GENERATE BUDGET PLOT.                                            A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      I1 ... I8 = BINARY STANDARD CCRN FILES OF GLOBAL AVERAGES                A3                                                  
C                                                                               A3                                                  
C                                                                               A3                                                  
CGRAPH DESCRIPTION ------------------- calculate terms in budget diagrams       A3                                                  
C                                      including indirect terms                 A3                                                  
C                                                                               A3                                                  
C                   **** note assumed direction of terms ****                   A3                                                  
C                                                                               A3                                                  
C                                             Gz           Dz                   A3                                                  
C                                               \          /                    A3                                                  
C                                      * 4- box  Az  ->  Kz                     A3                                                  
C                                                 |       ^                     A3                                                  
C                                                 v       |                     A3                                                  
C                                                 Ae ->  Ke                     A3                                                  
C                                                /         \                    A3                                                  
C                                             Ge             De                 A3                                                  
C                                                                               A3                                                  
C     * FURTHER COMMENTS...                                                     A3                                                  
C                                                                               A3                                                  
C     READ 8 FILES OF INPUT INTO (1) TO (8). (1) TO (4) USE FORMAT(F4.1)        A3                                                  
C     OTHER DATA ITEMS USES FORMAT(F5.2). 12 ITEMS WILL BE PUT INTO A GRAPH     A3                                                  
C     OF FOUR BOXES BY PROGRAM BUDPLOT ACCORDING TO THE FOLLOWING SEQUENCE.     A3                                                  
C     ITEM 1 -> UPPER LEFT BOX (WE CALL IT BOX 1)                               A3                                                  
C     ITEM 2 -> UPPER RIGHT BOX (WE CALL IT BOX 2)                              A3                                                  
C     ITEM 3 -> LOWER RIGHT BOX (WE CALL IT BOX 3)                              A3                                                  
C     ITEM 4 -> LOWER LEFT BOX (WE CALL IT BOX 4)                               A3                                                  
C     ITEM 5 -> ABOVE AN ARROW BETWEEN BOX 1 AND BOX 2                          A3                                                  
C     ITEM 6 -> BESIDE AN ARROW BETWEEN BOX 1 AND 4                             A3                                                  
C     ITEM 7 -> ABOVE AN ARROW BETWEEN BOX 4 AND 3                              A3                                                  
C     ITEM 8 -> BESIDE AN ARROW BETWEEN BOX 2 AND 3                             A3                                                  
C     ITEM 9 -> BESIDE AN ARROW POINTING AT BOX 1                               A3                                                  
C     ITEM 10 -> BESIDE AN ARROW POINTING OUT FROM BOX 2                        A3                                                  
C     ITEM 11 -> BESIDE AN ARROW POINTING OUT FROM BOX 3                        A3                                                  
C     ITEM 12 -> BESIDE AN ARROW POINTING AT BOX 4                              A3                                                  
C                                                                               A3                                                  
C     THE FOLLOWING GRAPH SHOWS THE APPROX. POSITION OF DATA IN THE GRAPH       A3                                                  
C      \                    /                                                   A3                                                  
C       \ 9             10 /                                                    A3                                                  
C        \_____     ______/                                                     A3                                                  
C        |    |  5  |    |                                                      A3                                                  
C        |  1 |---->| 2  |                                                      A3                                                  
C        |____|     |____|                                                      A3                                                  
C          ^          ^                                                         A3                                                  
C          |6         |8                                                        A3                                                  
C          |          |                                                         A3                                                  
C        ______     ______                                                      A3                                                  
C        |    |  7  |    |                                                      A3                                                  
C        | 4  |---->| 3  |                                                      A3                                                  
C        |____|     |____|                                                      A3                                                  
C       /                \                                                      A3                                                  
C    12/                  \11                                                   A3                                                  
C     /                    \                                                    A3                                                  
C                                                                               A3                                                  
C----------------------------------------------------------------------------   A3                                                  
C                                                                               A3                                                  
CINPUT PARAMETER...                                                             A5                                                  
C                                                                               A5                                                  
C      CARD 1- MAIN CARD                                                        A5                                                  
C                                                                               A5                                                  
C      READ(5,5010,END=901) (W(J),J=1,4), IBC                                   A5                                                  
C 5010 FORMAT(10X,5I5)                                                          A5                                                  
C                                                                               A5                                                  
C      W(I)       COLOR OF THE 4 BOXES                                          A5                                                  
C                 DEFAULT IS WHITE (BLANK OR ZERO)                              A5                                                  
C                 THE COLOR OF THE FIRST BOX IS THE DEFAULT COLOR OF ALL BOXES  A5                                                  
C                 IF OTHER BOXES ARE NOT SPECIFIED.                             A5                                                  
C      IBC        BOX AROUND VALUES                                             A5                                                  
C                 = 0 NO BOX (DEFAULT)                                          A5                                                  
C                 = 1 BOX                                                       A5                                                  
C                                                                               A5                                                  
C      CARD 2- TITLE                                                            A5                                                  
C                                                                               A5                                                  
C      READ(5,5020,END=901) NTIT                                                A5                                                  
C 5020 FORMAT(80A1)                                                             A5                                                  
C                                                                               A5                                                  
C      NTIT       TITLE OF DIAGRAM (80 CHARACTERS MAXIMUM)                      A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARD...                                                       A5                                                  
C                                                                               A5                                                  
C*BUDPLOT    180  160  160  160    1                                            A5                                                  
C*Main Title                                                                    A5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * Font size for the numbers in the boxes and beside the arrows                                                                
C     * and for the characters beside the boxes and arrows                                                                          
C                                                                                                                                   
      PARAMETER (BOXNO=.018, ARRNO=.014, BCHAR=.027, SCHAR=.016)                                                                    
      PARAMETER (TCHAR=.017)                                                                                                        
      PARAMETER (RBM=0.40)                                                                                                          
C                                                                                                                                   
C     * Scaling Factor for Jm^-2                                                                                                    
C                                                                                                                                   
      PARAMETER (SCALE=100000.)                                                                                                     
C                                                                                                                                   
C     * Size of each box and defining the title and comment areas.                                                                  
C                                                                                                                                   
      PARAMETER (SZX=.2, SZY=.16, Y0=.10, Y1=.10)                                                                                   
C                                                                                                                                   
C     * Define variables of binary data and 8-word labels.                                                                          
C                                                                                                                                   
      COMMON/F/F(361)                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(722)                                                                                                 
C                                                                                                                                   
C     * Store global average data and title.                                                                                        
C                                                                                                                                   
      REAL WORD(12)                                                                                                                 
      REAL WORD1,WORD2,WORD3,WORD4                                                                                                  
      CHARACTER*10 CS1,CS2,CS3,CS4                                                                                                  
      CHARACTER*1 NTIT(80),NT(85)                                                                                                   
      CHARACTER*80 TITLE                                                                                                            
      CHARACTER*85 MT                                                                                                               
C                                                                                                                                   
      LOGICAL OK,OK1,OK2,OK3,OK4,OK5,OK6,OK7,OK8                                                                                    
      INTEGER MO,MOM,IBC                                                                                                            
C                                                                                                                                   
C     * Array W stores hafton color values of 4 boxes read from input cards                                                         
C     * KT are the actual length of main title excluding space                                                                      
C     * on both sides.                                                                                                              
C                                                                                                                                   
      INTEGER W(4), FILPAT(200), KT                                                                                                 
C                                                                                                                                   
      REAL HSVV(3,25)                                                                                                               
C                                                                                                                                   
      EQUIVALENCE(TITLE,NTIT),(MT,NT)                                                                                               
      DATA MAXX/722/                                                                                                                
C                                                                                                                                   
C     * Color value array.                                                                                                          
C                                                                                                                                   
      DATA (FILPAT(I), I=100, 199)                                                                                                  
     +              /  2,  3,  4,  5,  6,  7,  8,  9, 10, 11,                                                                       
     2                12, 13, 14, 15, 16, 17, 18, 19, 20, 21,                                                                       
     3                22, 23, 24, 25, 26, 27, 28, 29, 30, 31,                                                                       
     4                32, 33, 34, 35, 36, 37,  0,  0,  0,  0,                                                                       
     5                42, 43, 44, 45, 46, 47, 48, 49, 50, 51,                                                                       
     6                52, 53, 54, 55, 56, 57, 58, 59, 60, 61,                                                                       
     7                62, 63, 64, 65, 66, 67, 68, 69, 70, 71,                                                                       
     8                72, 73, 74, 75, 76, 77, 78, 79, 80, 81,                                                                       
     9                82, 83, 84, 85, 86, 87, 88, 89, 90, 91,                                                                       
     +                92, 93, 94, 95, 96, 97, 98, 99, 100, 101 /                                                                    
                                                                                                                                    
C-------------------------------------------------------------------------                                                          
C                                                                                                                                   
C     * Import data file                                                                                                            
C                                                                                                                                   
      NFF=10                                                                                                                        
      CALL JCLPNT(NFF,11,12,13,14,15,16,17,18,5,6)                                                                                  
      REWIND 11                                                                                                                     
      REWIND 12                                                                                                                     
      REWIND 13                                                                                                                     
      REWIND 14                                                                                                                     
      REWIND 15                                                                                                                     
      REWIND 16                                                                                                                     
      REWIND 17                                                                                                                     
      REWIND 18                                                                                                                     
      CALL PSTART                                                                                                                   
      CALL BFCRDF(0)                                                                                                                
C                                                                                                                                   
      NRECS=0                                                                                                                       
C                                                                                                                                   
C     * Loop for reading records and drawing graphs                                                                                 
C                                                                                                                                   
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * Read from input card the parameters.                                                                                        
C                                                                                                                                   
      READ(5,5010,END=901)W(1),W(2),W(3),W(4), IBC                                                                                  
C                                                                                                                                   
C     * Make W(1) default colour                                                                                                    
C                                                                                                                                   
      IF (W(2).EQ.0) W(2)=W(1)                                                                                                      
      IF (W(3).EQ.0) W(3)=W(1)                                                                                                      
      IF (W(4).EQ.0) W(4)=W(1)                                                                                                      
C                                                                                                                                   
C     * COLOR                                                                                                                       
C                                                                                                                                   
      NCLRS=-4                                                                                                                      
      CALL DFCLRS(NCLRS,HSVV,W)                                                                                                     
C                                                                                                                                   
C     * Read main title                                                                                                             
C                                                                                                                                   
      READ(5,5020,END=901)NTIT                                                                                                      
C                                                                                                                                   
C     * Take away spaces in the both sides of title                                                                                 
C                                                                                                                                   
      CALL SHORTN(NTIT,80,.TRUE.,.TRUE.,KT)                                                                                         
C                                                                                                                                   
C     * Read in global averages from 8 files.                                                                                       
C                                                                                                                                   
      CALL GLOAVG(11,WORD(1),MAXX,OK1)                                                                                              
      CALL GLOAVG(12,WORD(2),MAXX,OK2)                                                                                              
      CALL GLOAVG(13,WORD(3),MAXX,OK3)                                                                                              
      CALL GLOAVG(14,WORD(4),MAXX,OK4)                                                                                              
      CALL GLOAVG(15,WORD(5),MAXX,OK5)                                                                                              
      CALL GLOAVG(16,WORD(6),MAXX,OK6)                                                                                              
      CALL GLOAVG(17,WORD(7),MAXX,OK7)                                                                                              
      CALL GLOAVG(18,WORD(8),MAXX,OK8)                                                                                              
      OK=OK1.AND.OK2.AND.OK3.AND.OK4.AND.OK5                                                                                        
     +     .AND.OK6.AND.OK7.AND.OK8                                                                                                 
      IF(.NOT.OK)THEN                                                                                                               
         WRITE(6,6000) NRECS                                                                                                        
         IF(NRECS.EQ.0)THEN                                                                                                         
            CALL                                   PXIT('BUDPLOT',-1)                                                               
         ELSE                                                                                                                       
            CALL                                   PXIT('BUDPLOT',0)                                                                
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * Compute global averages of record 9 to 12.                                                                                  
C                                                                                                                                   
      WORD(9)=WORD(5)+WORD(6)                                                                                                       
      WORD(10)=WORD(5)+WORD(8)                                                                                                      
      WORD(11)=WORD(7)-WORD(8)                                                                                                      
      WORD(12)=WORD(7)-WORD(6)                                                                                                      
C                                                                                                                                   
C     * Use the COMPLEX character set of PLOTCHAR.                                                                                  
C                                                                                                                                   
      CALL PCSETI('CC',1)                                                                                                           
C                                                                                                                                   
C     * Define some color indices and default drawing conditions.                                                                   
C                                                                                                                                   
      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)                                                                                                                  
C                                                                                                                                   
C     * Drawing the color boxes.                                                                                                    
C                                                                                                                                   
      MO=1                                                                                                                          
      DO 400 J=4,2,-2                                                                                                               
         Y = Y0+(J-1)*(SZY)                                                                                                         
         DO 300 I=2,4,2                                                                                                             
            X = (I-1)*(SZX)                                                                                                         
            IF(W(MO).GE.100.AND.W(MO).LE.199) THEN                                                                                  
             MOM=W(MO)-98                                                                                                           
            ELSE                                                                                                                    
             IF(W(MO).GE.350.AND.W(MO).LE.420) MOM=W(MO)-248                                                                        
            ENDIF                                                                                                                   
            CALL GSFACI(MOM)                                                                                                        
            MO=MO+1                                                                                                                 
            IF (MO.EQ.3) THEN                                                                                                       
             MO=4                                                                                                                   
            ELSE                                                                                                                    
             IF (MO.EQ.5) MO=3                                                                                                      
            ENDIF                                                                                                                   
            CALL DRBOX(X,Y,SZX,SZY,0)                                                                                               
 300     CONTINUE                                                                                                                   
 400  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * Draw the border lines of color squares                                                                                      
C                                                                                                                                   
      CALL SETUSV('LW',4000)                                                                                                        
      CALL GSPLCI(1)                                                                                                                
      DO 600 J=2,4,2                                                                                                                
         Y = Y0+(J-1)*(SZY)                                                                                                         
         DO 500 I=2,4,2                                                                                                             
            X = (I-1)*(SZX)                                                                                                         
            CALL LINE(X,Y,X+SZX,Y)                                                                                                  
            CALL LINE(X,Y,X,Y+SZY)                                                                                                  
            CALL LINE(X+SZX,Y,X+SZX,Y+SZY)                                                                                          
            CALL LINE(X,Y+SZY,X+SZX,Y+SZY)                                                                                          
 500     CONTINUE                                                                                                                   
 600  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * Plot labels.                                                                                                                
C                                                                                                                                   
      CALL GSPLCI(1)                                                                                                                
      CALL GSPMCI(1)                                                                                                                
      CALL GSFACI(1)                                                                                                                
      CALL GSTXCI(1)                                                                                                                
      CALL PCSETI('CC',1)                                                                                                           
C                                                                                                                                   
C     * Plot the title                                                                                                              
C                                                                                                                                   
      WRITE(MT,1008) TITLE(4:KT)                                                                                                    
      CALL SHORTN(NT,85,.TRUE.,.TRUE.,KT)                                                                                           
      CALL PLCHHQ(.5,.94,MT(4:KT),TCHAR,0.,0.)                                                                                      
C                                                                                                                                   
C     * Plot the comment                                                                                                            
C                                                                                                                                   
      CALL PLCHHQ(.5,.07, ":F21: 10:S:5:N: J:L:M:S:-2",SCHAR,0.,0.)                                                                 
      CALL PLCHHQ(.52,.03, ":F21:W:L:M:S:-2",SCHAR,0.,0.)                                                                           
      CALL LINE(.42,.075,.44,.075)                                                                                                  
      CALL LINE(.42,.055,.44,.055)                                                                                                  
      CALL LINE(.42,.055,.42,.075)                                                                                                  
      CALL LINE(.44,.055,.44,.075)                                                                                                  
      CALL ARDBD4(.46,.03,.38,.03)                                                                                                  
      IF(IBC.EQ.1) THEN                                                                                                             
         CALL LINE(.42,.04,.44,.04)                                                                                                 
         CALL LINE(.42,.02,.44,.02)                                                                                                 
         CALL LINE(.42,.04,.42,.02)                                                                                                 
         CALL LINE(.44,.04,.44,.02)                                                                                                 
         CALL GSFACI(0)                                                                                                             
         CALL DRBOX(.42,.02,.02,.02,0)                                                                                              
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * Plot the characters besides boxes.                                                                                          
C                                                                                                                                   
      CALL PLCHHQ(.30,.23,':F21:A:B1:E',BCHAR,0.,0.)                                                                                
      CALL PLCHHQ(.70,.23,':F21:K:B1:E',BCHAR,0.,0.)                                                                                
      CALL PLCHHQ(.30,.78,':F21:A:B1:Z',BCHAR,0.,0.)                                                                                
      CALL PLCHHQ(.70,.78,':F21:K:B1:Z',BCHAR,0.,0.)                                                                                
C                                                                                                                                   
C     * Plot the 12 word records in the graph.                                                                                      
C                                                                                                                                   
      WORD1 = WORD(1) / SCALE                                                                                                       
      WORD2 = WORD(2) / SCALE                                                                                                       
      WORD3 = WORD(3) / SCALE                                                                                                       
      WORD4 = WORD(4) / SCALE                                                                                                       
      WRITE (CS1,1006) WORD1                                                                                                        
      WRITE (CS2,1006) WORD2                                                                                                        
      WRITE (CS3,1006) WORD3                                                                                                        
      WRITE (CS4,1006) WORD4                                                                                                        
      CALL PLCHHQ(.30,.66,CS1,BOXNO,0.,0.)                                                                                          
      CALL PLCHHQ(.70,.66,CS2,BOXNO,0.,0.)                                                                                          
      CALL PLCHHQ(.30,.34,CS4,BOXNO,0.,0.)                                                                                          
      CALL PLCHHQ(.70,.34,CS3,BOXNO,0.,0.)                                                                                          
C                                                                                                                                   
      CALL SETCBOX(RBM,IBC)                                                                                                         
      CALL ARDBD1(.40,.66,.60,.66,WORD(5))                                                                                          
      CALL ARDBD1(.30,.58,.30,.42,WORD(6))                                                                                          
      CALL ARDBD1(.40,.34,.60,.34,WORD(7))                                                                                          
      CALL ARDBD1(.70,.42,.70,.58,WORD(8))                                                                                          
      CALL PCSETI ('BF - BOX FLAG',0)                                                                                               
      CALL ARDBD3(.07,.85,.20,.74)                                                                                                  
      CALL ARDBD3(.07,.15,.20,.26)                                                                                                  
      CALL ARDBD3(.80,.74,.93,.85)                                                                                                  
      CALL ARDBD3(.80,.26,.93,.14)                                                                                                  
      CALL SETCBOX(RBM,IBC)                                                                                                         
      CALL ARDBD2(.07,.85,.20,.74,WORD(9),'G','Z')                                                                                  
      CALL SETCBOX(RBM,IBC)                                                                                                         
      CALL ARDBD2(.07,.15,.20,.26,WORD(12),'G','E')                                                                                 
      CALL SETCBOX(RBM,IBC)                                                                                                         
      CALL ARDBD2(.80,.74,.93,.85,WORD(10),'D','Z')                                                                                 
      CALL SETCBOX(RBM,IBC)                                                                                                         
      CALL ARDBD2(.80,.26,.93,.14,WORD(11),'D','E')                                                                                 
C                                                                                                                                   
      CALL FRAME                                                                                                                    
C                                                                                                                                   
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
 901  CONTINUE                                                                                                                      
      CALL                                         PXIT('BUDPLOT',0)                                                                
C-------------------------------------------------------------------------                                                          
 1006 FORMAT(':F21:',F5.1)                                                                                                          
 1008 FORMAT(':F21:',A)                                                                                                             
 5010 FORMAT(10X,5I5)                                                                                                               
 5020 FORMAT(80A1)                                                                                                                  
 6000 FORMAT('BUDPLOT CONVERTED ',I5,' RECORDS')                                                                                    
      END                                                                                                                           
