      PROGRAM HDPLOT                                                                                                                
C     PROGRAM HDPLOT (IN,       INPUT,       OUTPUT,                    )       A2                                                  
C    1         TAPE10=IN, TAPE5=INPUT, TAPE6=OUTPUT,                                                                                
C    2                                 TAPE8       )                                                                                
C     ----------------------------------------------                            A2                                                  
C                                                                                                                                   
C     MAR 11/04 - M.BERKLEY (MODIFIED for NCAR V3.2)                            A2                                                  
C     DEC 31/97 - R. TAYLOR (CLEAN UP GGPLOT UPGRADE, FIX BUGS, TEST, TEST)                                                         
C     AUG 31/96 - T. GUI (UPDATE TO NCAR GRAPHICS V3.2)                                                                             
C     MAR 11/96 - F.MAJAESS (ISSUE WARNING WHEN PACKING DENSITY <= 0)                                                               
C     SEP 21/93 - M. BERKLEY (changed Holleriths to strings)                                                                        
C     SEP 21/93 - M. BERKLEY (changed to save data files instead of                                                                 
C                             generating meta code.)                                                                                
C     SEP  1/92 - T. JANG   (add format to write to unit 44)                                                                        
C     JUL 20/92 - T. JANG  (changed variable "MAX" to "MAXX" so not to                                                              
C                           conflict with the generic function "MAX")                                                               
C     DEC 11/91 - T.JANG   (DECLARE LBLX AND LBLY AS CHARACTER*8, ADD COMMON                                                        
C                           BLOCK /AGLW/ TO CHANGE LINE THICKNESS)                                                                  
C     APR  1/90 - C.BERGSTEIN (ADJUST TENSION TO 30.0)                                                                              
C     FEB 22/90 - C. BERGSETIN (SET UP FT44 FOR OVERLAY CONTROLING)                                                                 
C     JUL 13/89 - H.REYNOLDS (UPDATE TO NCAR GRAPHICS V2.0)                                                                         
C     NOV 24/83 - B.DUGAS.                                                                                                          
C     MAY 12/83 - R.LAPRISE.                                                                                                        
C                                                                               A2                                                  
CHDPLOT  - HARMONIC DIAL PLOT                                           1  1 C  A1                                                  
C                                                                               A3                                                  
CAUTHOR  - R.LAPRISE                                                            A3                                                  
C                                                                               A3                                                  
CPURPOSE - PLOTS A POLAR PLOT (HARMONIC DIAL) OF ONE SELECTED WAVENUMBER        A3                                                  
C          FROM A TIME SERIES OF SPECTRAL OR FOURIER FIELDS USING THE           A3                                                  
C          NCAR PLOT PACKAGE.                                                   A3                                                  
C          NOTE - PROGRAM READS DATA LABELLED WITH STANDARD 8 WORD LABEL.       A3                                                  
C                 THE MAXIMUM NUMBER OF POINTS IS 100.                          A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      IN = FILE CONTAINING TIME SERIES OF COMPLEX DATA.                        A3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               A5                                                  
C      CARD 1-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C                                                                               A5                                                  
C      READ(5,5010,END=900)NT1,NT2,INT,NAME,LVL,MW,NW,SCALF,XLO,XHI,YLO,YHI     A5                                                  
C 5010 FORMAT(10X,2I10,I5,1X,A4,I5,1X,2I2,5F6.0)                                A5                                                  
C                                                                               A5                                                  
C      NT1,NT2 = FIRST AND LAST STEP NUMBERS IN THE TIME SERIES                 A5                                                  
C      INT     = GRAPHING INTERVAL (IN TIME)                                    A5                                                  
C      NAME    = NAME  OF FIELD TO BE PLOTTED                                   A5                                                  
C      LVL     = LEVEL OF FIELD TO BE PLOTTED                                   A5                                                  
C      MW      = THE FOURIER WAVE NUMBER.                                       A5                                                  
C      NW      = (IF KIND = NC4TO8('SPEC')), THE ORDER OF THE SPHERICAL HARMONICA5                                                  
C                (IF KIND = NC4TO8('FOUR')), THE LAT NUMBER (FROM S.P. TO N.P.) A5                                                  
C      SCALF   = SCALE FACTOR FOR THE AMPLITUDES                                A5                                                  
C                SCALING IS AUTOMATIC IF XLO=0.                                 A5                                                  
C      XLO,XHI = X PLOT LIMITS                                                  A5                                                  
C      YLO,YHI = Y PLOT LIMITS                                                  A5                                                  
C                                                                               A5                                                  
C      CARD 2-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C                                                                               A5                                                  
C      READ(5,5020,END=080)(LABEL(K),K=1,80)                                    A5                                                  
C 5020 FORMAT(80A1)                                                             A5                                                  
C                                                                               A5                                                  
C      LABEL   = 80 CHARACTER LABEL PRINTED ON THE PLOT                         A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARDS...                                                      A5                                                  
C                                                                               A5                                                  
C*  HDPLOT         0        96    1 TEMP  500  6 6    1.  -1.0  +1.0  -1.0  +1.0A5                                                  
C* HARMONIC DIAL OF TEMPERATURE WAVE                                            A5                                                  
C------------------------------------------------------------------------------                                                     
C                                                                                                                                   
      LOGICAL IEZ,OK,LAB                                                                                                            
      INTEGER LSR(2,66), IHOLD(8)                                                                                                   
      CHARACTER ALABEL*83                                                                                                           
      CHARACTER*1 LABEL(83)                                                                                                         
      EQUIVALENCE (LABEL,ALABEL)                                                                                                    
      REAL X(100),Y(100)                                                                                                            
      CHARACTER*8 LBLX, LBLY                                                                                                        
                                                                                                                                    
C     logical unit numbers for saving card images, data, etc.                                                                       
      INTEGER LUNCARD,UNIQNUM,LUNDATAFILES(1)                                                                                       
      PARAMETER (LUNOFFSET=10,                                                                                                      
     1     LUNFIELD1=LUNOFFSET+1)                                                                                                   
                                                                                                                                    
C                                                                                                                                   
      COMMON/BLANCK/ F(9264)                                                                                                        
      COMPLEX F,CF                                                                                                                  
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(37056)                                                                                               
                                                                                                                                    
C                                                                                                                                   
C     * COMMON BLOCK FOR PWRITY - NEEDED TO CHANGE FONTS                                                                            
C                                                                                                                                   
      COMMON /PUSER/ MODE                                                                                                           
C                                                                                                                                   
C     * DECLARE NCAR PLUGINS EXTERNAL, SO CORRECT VERSION ON SGI                                                                    
C                                                                                                                                   
      EXTERNAL AGCHCU                                                                                                               
      EXTERNAL AGCHNL                                                                                                               
      EXTERNAL AGPWRT                                                                                                               
C                                                                                                                                   
C     * DECLARE BLOCK DATAS EXTERNAL, SO INITIALIZATION HAPPENS                                                                     
C                                                                                                                                   
      EXTERNAL AGCHCU_BD                                                                                                            
      EXTERNAL FILLCBBD                                                                                                             
      EXTERNAL FILLPAT_BD                                                                                                           
C                                                                                                                                   
C     * COMMON BLOCK FOR EZXY AND PWRITY - NEEDED TO CHANGE LINE THICKNESS                                                          
C                                                                                                                                   
      COMMON /AGLW/ LWBG, LWMJ, LWMN                                                                                                
C                                                                                                                                   
      DATA MAXPTS/100/, MAXX/37056/                                                                                                 
      DATA LBLX/'REAL#'/, LBLY/'-IMAG#'/                                                                                            
                                                                                                                                    
C                                                                                                                                   
C     * PWRITY HAS 2 FONTS TO CHOOSE FROM.  THE DEFAULT FONT                                                                        
C     * IS THE COMPLEX FONT AND THE OTHER IS THE DUPLEX FONT.                                                                       
C     * TELL PWRITY TO USE DUPLEX CHARACTER FONT                                                                                    
C                                                                                                                                   
      MODE = 1                                                                                                                      
C                                                                                                                                   
C     * CHANGE BACKGROUND LINE THICKNESS FOR PWRITY                                                                                 
C                                                                                                                                   
      LWBG = 2000                                                                                                                   
C                                                                                                                                   
C     * CHANGE MAJOR LINE THICKNESS FOR EZXY                                                                                        
C                                                                                                                                   
      LWMJ = 2000                                                                                                                   
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,LUNFIELD1,5,6)                                                                                                
      CALL PSTART                                                                                                                   
                                                                                                                                    
      CALL PCSETI('FN', 12)                                                                                                         
      CALL PCSETI('OF', 1)                                                                                                          
      CALL PCSETI('OL', 2)                                                                                                          
      CALL PCSETR('CL',.2)                                                                                                          
      CALL BFCRDF(0)                                                                                                                
      CALL GSLWSC(2.0)                                                                                                              
      CALL AGSETC('LINE/END.','#')                                                                                                  
C                                                                                                                                   
C     * READ IN CONTROL INFORMATION AND TITLE FROM CARD.                                                                            
C                                                                                                                                   
  050 REWIND LUNFIELD1                                                                                                              
      READ(5,5010,END=900)NT1,NT2,INT,NAME,LVL,MW,NW,SCALF,XLO,XHI,YLO,                                                             
     1                                                             YHI                                                              
      WRITE(6,6010)NT1,NT2,INT,NAME,LVL,MW,NW,SCALF,XLO,XHI,YLO,YHI                                                                 
      LAB=.FALSE.                                                                                                                   
      DO 070 I=1,80                                                                                                                 
  070    LABEL(I)=' '                                                                                                               
      READ(5,5020,END=080)(LABEL(K),K=1,80)                                                                                         
      LAB=.NOT.LAB                                                                                                                  
  080 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * READ IN DATA.                                                                                                               
C                                                                                                                                   
      NPTS=0                                                                                                                        
  100 CALL GETFLD2(LUNFIELD1,F,-1,-1,NAME,LVL,IBUF,MAXX,OK)                                                                         
                                                                                                                                    
      IF(IBUF(8).LE.0) WRITE(6,6090) IBUF(8)                                                                                        
                                                                                                                                    
      NT=IBUF(2)                                                                                                                    
      IF(.NOT.OK .OR. NT.GT.NT2)THEN                                                                                                
        IF(NPTS.EQ.0)CALL                          PXIT('HDPLOT',-1)                                                                
        GO TO 500                                                                                                                   
      ENDIF                                                                                                                         
      IF (NT.LT.NT1)GO TO 100                                                                                                       
      IF(MOD(NT-NT1,INT).NE.0)GO TO 100                                                                                             
C                                                                                                                                   
C     * FORM TIME SERIES.                                                                                                           
C                                                                                                                                   
      NPTS=NPTS+1                                                                                                                   
      IF(NPTS.GT.MAXPTS) CALL                      PXIT('HDPLOT',-2)                                                                
      KIND=IBUF(1)                                                                                                                  
      IF(KIND.NE.NC4TO8('SPEC').AND.KIND.NE.NC4TO8('FOUR'))                                                                         
     1     CALL                                    PXIT('HDPLOT',-3)                                                                
      IF(KIND.EQ.NC4TO8('FOUR')) THEN                                                                                               
C                                                                                                                                   
C          * FOURIER COEFFICIENT CASE.                                                                                              
C                                                                                                                                   
           LM=IBUF(5)                                                                                                               
           NLAT=IBUF(6)                                                                                                             
           IF(MW.GT.LM-1 .OR. NW.GT.NLAT) CALL     PXIT('HDPLOT',-4)                                                                
           K=(NW-1)*LM +MW+1                                                                                                        
                                                                                                                                    
      ELSE                                                                                                                          
C                                                                                                                                   
C     * SPHERICAL HARMONIC COEFFICIENT CASE.                                                                                        
C                                                                                                                                   
           IF(NW.LT.MW) CALL                       PXIT('HDPLOT',-5)                                                                
           LRLMT=IBUF(7)                                                                                                            
           CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                       
           IF(MW.GT.LM-1 .OR. NW-MW.GT.LSR(1,MW+2)-LSR(1,MW+1))                                                                     
     1         CALL                                PXIT('HDPLOT',-6)                                                                
           K=LSR(1,MW+1)+NW-MW                                                                                                      
                                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
      CF=F(K)                                                                                                                       
      IF(MW.GT.0)CF=2.*CF                                                                                                           
      X(NPTS)=REAL(CF)                                                                                                              
      Y(NPTS)=- IMAG(CF)                                                                                                            
                                                                                                                                    
      DO 200 I=1,8                                                                                                                  
           IHOLD(I)=IBUF(I)                                                                                                         
  200 CONTINUE                                                                                                                      
                                                                                                                                    
      GO TO 100                                                                                                                     
                                                                                                                                    
C                                                                                                                                   
C     * PLOT TIME SERIES.                                                                                                           
C                                                                                                                                   
  500 CONTINUE                                                                                                                      
      IF(SCALF.EQ.0.)SCALF=1.                                                                                                       
      IEZ=.FALSE.                                                                                                                   
      IF(XLO.EQ.0. .AND. XHI.EQ.0. .AND. YLO.EQ.0. .AND. YHI.EQ.0.)                                                                 
     1                                                   IEZ=.TRUE.                                                                 
      WRITE(6,6025)IHOLD                                                                                                            
                                                                                                                                    
      PRINT *, 'X: ', (X(I), I=1,NPTS)                                                                                              
      PRINT *, 'Y: ', (Y(I), I=1,NPTS)                                                                                              
                                                                                                                                    
C                                                                                                                                   
      CALL SHORTN(LABEL,83,.TRUE.,.TRUE.,NC)                                                                                        
      CALL XYPLOT(X,Y,NPTS,ALABEL,NC,LBLX,LBLY,SCALF,IEZ,                                                                           
     1            XLO,XHI,YLO,YHI)                                                                                                  
      WRITE(6,6030)XLO,XHI,YLO,YHI                                                                                                  
C                                                                                                                                   
C     * NEXT PLOT.                                                                                                                  
C                                                                                                                                   
      IF(LAB) GO TO 050                                                                                                             
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
                                                                                                                                    
  900 CALL                                         PXIT('HDPLOT',0)                                                                 
C-----------------------------------------------------------------------                                                            
 5010 FORMAT(10X,2I10,I5,1X,A4,I5,1X,2I2,5F6.0)                                                                                     
 5020 FORMAT(80A1)                                                                                                                  
 6010 FORMAT(10X,2I10,I5,1X,A4,I5,1X,2I2,5F6.0)                                                                                     
 6025 FORMAT(' ',A4,I10,2X,A4,5I6)                                                                                                  
 6030 FORMAT(' XLO=',E15.3,',XHI=',E15.3,',YLO=',E15.3,',YHI=',E15.3)                                                               
 6090 FORMAT(/,' *** WARNING: PACKING DENSITY = ', I4,' ***',/)                                                                     
      END                                                                                                                           
