      PROGRAM SPPLOT                                                                                                                
C     PROGRAM SPPLOT (SPEC,       INPUT,       OUTPUT,                  )       A2                                                  
C    1          TAPE1=SPEC, TAPE5=INPUT, TAPE6=OUTPUT,                                                                              
C    2                                   TAPE8       )                                                                              
C     ------------------------------------------------                          A2                                                  
C                                                                                                                                   
C     FEB 20/08 - F.MAJAESS (SEVERAL APPLIED CORRECTIONS)                       A2                                                  
C     AUG 23/07 - B.MIVILLE (ARBITRARY CONTOURS, 28 COLOURS, NEW LEGEND)                                                            
C     NOV 20/07 - F.MAJAESS (MAKE "INTPR" COMMON BLOCK DECLARATION CONSISTENT                                                       
C                            WITH THAT IN THE OTHER SOURCE CODE)                                                                    
C     MAY 13/04 - F.MAJAESS (ENSURE "ITYPE" CHECK IS DONE AS INTEGER.                                                               
C                            ADDED "INZERO" TO "CONCCC" BLOCK)                                                                      
C     MAR 11/04 - M.BERKLEY (MODIFIED for NCAR V3.2)                                                                                
C     DEC 31/97 - R. TAYLOR (CLEAN UP GGPLOT UPGRADE, FIX BUGS, TEST, TEST)                                                         
C     AUG 31/96 - TAO GUI (UPDATE TO NCAR V3.2)                                                                                     
C     MAY 07/96 - F.MAJAESS (REVISE DFCLRS CALL)                                                                                    
C     MAR 11/96 - F.MAJAESS (ISSUE WARNING WHEN PACKING DENSITY <= 0)                                                               
C     NOV 21/94 - F.MAJAESS (ENABLE 'GO TO 100' LINE)                                                                               
C     APR 25/94 - F.MAJAESS (CORRECT SHADING OPTION SETUP)                                                                          
C     JAN 12/94 - F.MAJAESS (CORRECT "SKIP" OPTION )                                                                                
C     SEP 21/93 - M. BERKLEY (changed Holleriths to strings)                                                                        
C     SEP 22/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     AUG 27/91 - S. WILSON (ADD COLOUR SHADING)                                                                                    
C     APR 17/90 - C.BERGSTEIN (CHANGE SPVAL TO 1.E38)                                                                               
C     JUL 05/89 - H. REYNOLDS (UPDATE TO NCAR GRAPHICS V2.0)                                                                        
C     MAY 15/86 - F.ZWIERS. (PUB QUALITY OPTION)                                                                                    
C     SEP 17/85 - B.DUGAS. (NULBLL=1 ET NDOT=-1733B)                                                                                
C     NOV 29/83 - N.E.SARGENT.                                                                                                      
C                                                                               A2                                                  
CSPPLOT  - PLOTS A 2-D SPECTRUM                                         1  1 C  A1                                                  
C                                                                               A3                                                  
CAUTHOR  - N.E.SARGENT.                                                         A3                                                  
C                                                                               A3                                                  
CPURPOSE - CONTOUR THE REAL PART OF A TRIANGULARLY TRUNCATED SPECTRAL           A3                                                  
C          FIELD IN FILE SPEC.  THE RESULT IS A 2-D SPECTRUM PLOT OF            A3                                                  
C          SPHERICAL HARMONIC COEFFICIENTS.                                     A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      SPEC = FILE CONTAINING THE SPECTRAL FIELD TO BE PLOTTED.                 A3                                                  
C                                                                               A3                                                  
CCARDS READ...                                                                  A5                                                  
C                                                                               A5                                                  
C      CARD 1-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C                                                                               A5                                                  
C      READ(5,5010) NSTEP,NAME,LEVEL,SCAL,FLO,FHI,FINC,                         A5                                                  
C                   ICOSH,LHI,ISCAL,MS,IHEM                                     A5                                                  
C 5010 FORMAT(10X,I10,1X,A4,I5,4E10.0,I1,2I2,1X,2I2)                            A5                                                  
C                                                                               A5                                                  
C      NSTEP  = TIMESTEP NUMBER                                                 A5                                                  
C      NAME   = NAME OF FIELD TO BE CONTOURED,                                  A5                                                  
C               IF NAME=NC4TO8('NEXT') THE NEXT SPEC FIELD IS PLOTTED           A5                                                  
C               IF NAME=NC4TO8('SKIP') THE NEXT SPEC FIELD IS SKIPPED           A5                                                  
C      LEVEL  = LEVEL NUMBER                                                    A5                                                  
C      SCAL   = SCALING FACTOR FOR FIELD TO BE CONTOURED (0. DEFAULTS TO 1.)    A5                                                  
C      FLO    = LOWEST VALUE OF SCALED FIELD TO BE CONTOURED                    A5                                                  
C      FHI    = HIGHEST VALUE TO BE CONTOURED                                   A5                                                  
C      FINC   = CONTOUR INTERVAL                                                A5                                                  
C      ICOSH  = 0 => NO SHADING                                                 A5                                                  
C               1 => SHADING                                                    A5                                                  
C      LHI        =0,1,HIGHS,LOWS LABELLED. LON   0 IN CENTRE. M,P DRAWN.       A5                                                  
C                 =-1, .......NOT LABELLED. LON   0 IN CENTRE. M,P DRAWN.       A5                                                  
C                 = 2, HIGHS,LOWS LABELLED. LON 180 IN CENTRE. M,P DRAWN.       A5                                                  
C                 =-2, .......NOT LABELLED. LON 180 IN CENTRE. M,P DRAWN.       A5                                                  
C                 = 3, HIGHS,LOWS LABELLED. LON   0 IN CENTRE. M,P NOT DRAWN.   A5                                                  
C                 =-3, .......NOT LABELLED. LON   0 IN CENTRE. M,P NOT DRAWN.   A5                                                  
C                 = 4, HIGHS,LOWS LABELLED. LON 180 IN CENTRE. M,P NOT DRAWN.   A5                                                  
C                 =-4, .......NOT LABELLED. LON 180 IN CENTRE. M,P NOT DRAWN.   A5                                                  
C                 =+5, AS LHI=0, CONTOUR LINES NOT LABELLED.                    A5                                                  
C                 =+6, AS LHI=+1, CONTOUR LINES NOT LABELLED.                   A5                                                  
C                 =-6, AS LHI=-1, CONTOUR LINES NOT LABELLED.                   A5                                                  
C                 = ...                                                         A5                                                  
C                      .                                                        A5                                                  
C                       .                                                       A5                                                  
C                        ...                                                    A5                                                  
C                 = -9, AS LHI=-4, CONTOUR LINES NOT LABELLED.                  A5                                                  
C                                                                               A5                                                  
C      ISCAL  = DETERMINES WETHER THE M.NE.0. PART OF THE FIELD IS TO           A5                                                  
C               BE DIVIDED BY 2. AND/OR WETHER THE FIELD OR THE LOG             A5                                                  
C               OF THE FIELD IS TO BE CONTOURED IN THE FOLLOWING WAY:           A5                                                  
C               1) ISCAL.LT.0      THEN LOG10(FIELD) IS CONTOURED.              A5                                                  
C               2) ISCAL.GE.0      THEN       FIELD  IS CONTOURED.              A5                                                  
C               3) ABS(ISCAL).EQ.2 THEN DIVIDE THE M.NE.0 PART OF               A5                                                  
C                                       FIELD BY 2.                             A5                                                  
C      MS         PUBLICATION QUALITY OPTIONS:                                  A5                                                  
C                                                                               A5                                                  
C                 IF MS.LT.0, THEN PUBLICATION QUALITY OPTION IS SET, AND       A5                                                  
C                 PLOTS HAVE: TITLE, THICK LINES, NO INFORMATION LABEL, AND     A5                                                  
C                 ALL CONTOUR LINES ARE SAME WIDTH.  LHI IS SET TO -1, SO NO    A5                                                  
C                 HIGH/LOW LABELS ARE DISPLAYED, AND MAP IS CENTRED ON LON 0.   A5                                                  
C                                                                               A5                                                  
C                 IF MS.GE.0, THEN NORMAL QUALITY OPTION IS SET, AND PLOTS      A5                                                  
C                 HAVE THICK/THIN LINES, AND HIGH/LOW LABELS (DEPENDING UPON    A5                                                  
C                 LHI SETTING.  IN ADDITION, IF MS                              A5                                                  
C                  =4,  NO INFO LABEL, NO TITLE, NO LEGEND                      A5                                                  
C                  =3,  NO INFO LABEL, NO TITLE                                 A5                                                  
C                  =2,  NO INFO LABEL                                           A5                                                  
C                  =1,  NO TITLE                                                A5                                                  
C                  =0   NORMAL INFO LABEL AND TITLE                             A5                                                  
C                                                                               A5                                                  
C      IHEM   = CONTROLS INTERPOLATION FOR HEMISPHERIC DATA                     A5                                                  
C               DEFULTS IS ZERO; NO INTERPOLATION                               A5                                                  
C                                                                               A5                                                  
C      CARD 2-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C                                                                               A5                                                  
C      READ(5,5012) (LABEL(I),I=1,80)                                           A5                                                  
C 5012 FORMAT(80A1)                                                             A5                                                  
C                                                                               A5                                                  
C      LABEL  = 80 CHARACTER LABEL FOR PLOT, (OMITTED IF NAME=NC4TO8('SKIP')).  A5                                                  
C                                                                               A5                                                  
C      FOR SHADING                                                              A5                                                  
C      ===========                                                              A5                                                  
C      CARD 3-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C      READ(5,5056) WHITFG, NPAT, (IPAT(I),I=1,7)                               A5                                                  
C      ...                                                                      A5                                                  
C      READ(5,5055) (IPAT(I),I=22,NPAT)                                         A5                                                  
C 5055 FORMAT(15X,7I5)                                                          A5                                                  
C 5056 FORMAT(10X,I1,I4,7I5)                                                    A5                                                  
C                                                                               A5                                                  
C      WHITFG      .NE. 0 IF COLOUR PLOTS ARE TO HAVE WHITE CONTOURS            A5                                                  
C      NPAT        NUMBER OF DIFFERENT RANGES TO SHADE (MAXIMUM 28 COLOURS)     A5                                                  
C      IPAT(NPAT)  NPAT SHADING PATTERN CODES                                   A5                                                  
C                                                                               A5                                                  
C      CARD 4-                                                                  A5                                                  
C      -------                                                                  A5                                                  
C      READ(5,5057) (ZLEV(I),I=1,NPAT-1)                                        A5                                                  
C 5057 FORMAT(10X,7E10.0)                                                       A5                                                  
C                                                                               A5                                                  
C      ZLEV(I) =    NPAT-1 DATA VALUES AT WHICH TO CHANGE SHADING PATTERNS.     A5                                                  
C                   THE FIRST IPAT PATTERN WILL SHADE THE CONTOUR LEVEL         A5                                                  
C                   WITH VALUES < ZLEV(1). THE SECOND IPAT PATTERN WILL         A5                                                  
C                   SHADE AREAS WITH VALUES BETWEEN ZLEV(1) AND ZLEV(2),        A5                                                  
C                   AND SO ON FOR THE REST OF THE ARRAY. THE LAST(NPAT)         A5                                                  
C                   IPAT PATTERN WILL SHADE THE CONTOUR LEVEL WITH              A5                                                  
C                   VALUES > ZLEV(NPAT-1).                                      A5                                                  
C                                                                               A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARDS...                                                      A5                                                  
C                                                                               A5                                                  
C*  SPPLOT  79010100 TEMP 1000        1.        0.      300.       10.   -2  0  A5                                                  
C*  JANUARY FIRST PLOT OF LOG SCALE OF TEMPERATURE AT 1000MB                    A5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
                                                                                                                                    
      DIMENSION BOX(8450),LSR(2,66),BOXNEW(66049),DUM1(66049)                                                                       
      DIMENSION DUM2(8450),DUM3(257),DUM4(8450),DUM5(257)                                                                           
                                                                                                                                    
      COMPLEX SP                                                                                                                    
      LOGICAL OK,LEAD,TRAIL,LGND,CLRPLT,CLRINIT                                                                                     
      CHARACTER*2 LWN(7)                                                                                                            
      CHARACTER*1 LABEL(83)                                                                                                         
      CHARACTER ALABEL*83                                                                                                           
      CHARACTER*10 LI1,LI2,LI3,LI4                                                                                                  
      EQUIVALENCE (LABEL,ALABEL)                                                                                                    
      INTEGER NPAT,IPAT(28),NWDS,WHITFG                                                                                             
      INTEGER ISIZ, ITSIZ                                                                                                           
      INTEGER MAJLW,MINLW,LOWMKR,HIMKR,INZERO                                                                                       
      LOGICAL LAB_FLAG                                                                                                              
      REAL ZLEV(28),HSVV(3,28),PT                                                                                                   
                                                                                                                                    
      COMMON /FILLCB/ IPAT, ZLEV, NPAT, MAXPAT, MAXCLRS                                                                             
                                                                                                                                    
C                                                                                                                                   
      CHARACTER*4 ATYPE, CSPPL                                                                                                      
      INTEGER*4 ITYPE, ISPPL                                                                                                        
C ITYPE is used by all plotting programs.                                                                                           
      COMMON /CCCPLOT/ ITYPE                                                                                                        
C ARG is used by LBFILL                                                                                                             
      INTEGER ARG                                                                                                                   
      COMMON /PAT/ ARG                                                                                                              
                                                                                                                                    
C Publication common block                                                                                                          
      LOGICAL PUB, DOTITLE, DOINFOLABEL, DOLGND, DOLABEL, SHAD                                                                      
      COMMON /PPPP/ PUB, SHAD, DOTITLE, DOINFOLABEL, DOLGND, DOLABEL                                                                
C     * COMMON BLOCK FOR SETTING LINE THICKNESSES.                                                                                  
C                                                                                                                                   
C Workspace arrays for NCARG routines.                                                                                              
      INTEGER LRWK, LIWK                                                                                                            
      PARAMETER (LRWK=1500000, LIWK=700000)                                                                                         
      REAL RWRK(LRWK)                                                                                                               
      INTEGER IWRK(LIWK)                                                                                                            
COLour CONtour plotting routine.                                                                                                    
      INTEGER SP_MAP_SIZE                                                                                                           
      PARAMETER (SP_MAP_SIZE=2000000)                                                                                               
      INTEGER SP_MAP(SP_MAP_SIZE)                                                                                                   
      COMMON /SP_AREA/SP_MAP                                                                                                        
      INTEGER NWRK, NOGRPS                                                                                                          
      PARAMETER (NWRK=15000,NOGRPS=5)                                                                                               
      REAL XWRK(NWRK), YWRK(NWRK)                                                                                                   
      INTEGER IAREA(NOGRPS), IGRP(NOGRPS)                                                                                           
                                                                                                                                    
CDEBUG                                                                                                                              
      CHARACTER*15 LLTXT                                                                                                            
CDEBUG                                                                                                                              
C                                                                                                                                   
      CHARACTER*140 INFOLABEL                                                                                                       
C                                                                                                                                   
C     logical unit numbers for saving card images, data, etc.                                                                       
      INTEGER LUNCARD,UNIQNUM,LUNDATAFILES(1)                                                                                       
      PARAMETER (LUNOFFSET=10,                                                                                                      
     1     LUNFIELD1=LUNOFFSET+1)                                                                                                   
                                                                                                                                    
      COMMON /BLANCK/SP(2210),SCOM(4420)                                                                                            
      COMMON /ICOM/IBUF(8),IDAT(8840)                                                                                               
      COMMON /CONRE1/IOFFP,SPVAL                                                                                                    
      COMMON /CONCCC/MAJLW,MINLW,LOWMKR,HIMKR,INZERO                                                                                
                                                                                                                                    
      COMMON /INTPR/                                                                                                                
     1     IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,ICLOSE                                                                   
      INTEGER IPAU,NP,L1,MLLINE,ICLOSE                                                                                              
      REAL FPART,TENSN,SMALL,ADDLR,ADDTB                                                                                            
                                                                                                                                    
      COMMON /CONRE4/ ISIZEL,ISIZEM,ISIZEP,NREP,NCRT,ILAB,NULBLL,IOFFD,                                                             
     1                EXT,IOFFM,ISOLID,NLA,NLM,XLT,YBT,SIDE                                                                         
      COMMON /PUSER/ MODE                                                                                                           
                                                                                                                                    
      EQUIVALENCE (CSPPL,ISPPL)                                                                                                     
                                                                                                                                    
C                                                                                                                                   
C                                                                                                                                   
C     * DECLARE NCAR PLUGINS EXTERNAL, SO CORRECT VERSION ON SGI                                                                    
C                                                                                                                                   
      EXTERNAL AGCHNL,AGPWRT,CPDRPL,CPCHHL,CPCHIL,CONTDF,                                                                           
     1         DFNCLR,GGP_COLSHD,GGP_COLSMSHD,GGP_CONLS,                                                                            
     2         GGP_ILDEF,GGP_LEGEND,GGP_PATTERN,HOV_LEGEND,                                                                         
     3         LBFILL,MAPUSR,NEW_HAFTNP,PATTERN,PCHIQU,PCMEQU,                                                                      
     4         PLCHHQ,SAMPLE,SETPAT,SP_LEGEND,STRINDEX                                                                              
C                                                                                                                                   
C     * DECLARE BLOCK DATAS EXTERNAL, SO INITIALIZATION HAPPENS                                                                     
C                                                                                                                                   
      EXTERNAL AGCHCU_BD                                                                                                            
      EXTERNAL FILLCBBD                                                                                                             
      EXTERNAL FILLPAT_BD                                                                                                           
C                                                                                                                                   
                                                                                                                                    
C                                                                                                                                   
C     * DATA PERTAINING TO CHARACTER SIZES FOR PCHIQU.                                                                              
C     * NOTE:  THE FONT PCHIQU USES IS DIGITIZED TO BE 32 PLOTTER                                                                   
C     * COORDINATE UNITS (PLU) HIGH - THIS INCLUDES SPACE ABOVE THE                                                                 
C     * CHARACTER.  THE ACTUAL CHARACTER HEIGHT IS 21 PLU.  THEREFORE,                                                              
C     * THE ACTUAL HEGHT FOR A GIVEN CHARACTER SIZE CAN BE DETERMINED                                                               
C     * BY MULTIPLYING BY THE RATIO 32/21 = 1.52381                                                                                 
C                                                                                                                                   
      DATA ITSIZ /18/, ISIZ /14/, CHRATIO /1.52381/                                                                                 
                                                                                                                                    
      DATA MAXX/8840/                                                                                                               
      DATA LWN/'0 ','10','20','30','40','50','60'/                                                                                  
C--------------------------------------------------------------                                                                     
      CSPPL='SPPL'                                                                                                                  
                                                                                                                                    
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,LUNFIELD1,5,6)                                                                                                
      CALL PSTART                                                                                                                   
      REWIND LUNFIELD1                                                                                                              
C                                                                                                                                   
C     * LINE WIDTHS (BACKGROUD, MAJOR AND MINOR)                                                                                    
C                                                                                                                                   
      LWBG=1000                                                                                                                     
      LWBGP=1500                                                                                                                    
      LWMJ=2000                                                                                                                     
      LWMJP=2000                                                                                                                    
      LWMN=1500                                                                                                                     
      LWMNP=2000                                                                                                                    
C                                                                                                                                   
C     * Initialize some parameters                                                                                                  
C                                                                                                                                   
C     ITYPE = 'SPPL'                                                                                                                
      ITYPE = ISPPL                                                                                                                 
      INZERO=-1                                                                                                                     
      LAB_FLAG = .TRUE.                                                                                                             
      DOTITLE=.TRUE.                                                                                                                
      DOINFOLABEL=.TRUE.                                                                                                            
C                                                                                                                                   
C     Use in LBFILL to do non-color shading                                                                                         
C                                                                                                                                   
      ARG=0                                                                                                                         
C                                                                                                                                   
C     * SELECT DUPLEX FONT                                                                                                          
C                                                                                                                                   
      MODE=1                                                                                                                        
                                                                                                                                    
C                                                                                                                                   
C     * PARAMETER TO CONTROL RESOLUTION OF INTERPOLATED PLOTTING GRID                                                               
C                                                                                                                                   
      INCR=3                                                                                                                        
C                                                                                                                                   
C     * OTHER PLOTTING SPECIFICATIONS                                                                                               
C                                                                                                                                   
      MLLINE=43                                                                                                                     
      SPVAL=1.0E38                                                                                                                  
      ISIZEM=6                                                                                                                      
                                                                                                                                    
C                                                                                                                                   
C     * SET THE INITIALIZE COLOUR FLAG TO FALSE.                                                                                    
C                                                                                                                                   
      CLRINIT = .FALSE.                                                                                                             
                                                                                                                                    
C                                                                                                                                   
C     * READ A CARD IDENTIFYING THE FIELDS TO BE PLOTTED.                                                                           
C     * IF NAME=NC4TO8('SKIP') JUST SKIP THE NEXT RECORD ON THE FILE.                                                               
C     * OTHERWISE READ THE LABELS TO BE PRINTED OVER THE PLOT.                                                                      
C                                                                                                                                   
  100 READ(5,5010,END=901) NSTEP,NAME,LEVEL,SCAL,FLO,FHI,FINC,                                                                      
     1                     ICOSH,LHI,ISCAL,MS,IHEM                                                                                  
      IF(NAME.EQ.NC4TO8('SKIP'))THEN                                                                                                
        CALL FBUFFIN(LUNFIELD1,IBUF,MAXX,KKK,LLEN)                                                                                  
        IF (KKK.GE.0) GO TO 903                                                                                                     
        GOTO 100                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF (LHI.LT.0) THEN                                                                                                            
         IF(LHI.LT.-4) THEN                                                                                                         
            LHI=LHI+5                                                                                                               
            LAB_FLAG=.FALSE.                                                                                                        
         ENDIF                                                                                                                      
      ELSE                                                                                                                          
         IF(LHI.GT.4) THEN                                                                                                          
            LHI=LHI-5                                                                                                               
            LAB_FLAG=.FALSE.                                                                                                        
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C                                                                                                                                   
      READ(5,5012,END=902) (LABEL(I),I=1,80)                                                                                        
                                                                                                                                    
      IF(SCAL.EQ.0.) SCAL=1.                                                                                                        
      IF (MS.LT.0)      THEN                                                                                                        
          PUB=.TRUE.                                                                                                                
          DOTITLE=.TRUE.                                                                                                            
          DOINFOLABEL=.FALSE.                                                                                                       
          DOLGND=.FALSE.                                                                                                            
          DOLABEL=.TRUE.                                                                                                            
          CALL GSLWSC(2.0)                                                                                                          
          MAJLW=LWMJP                                                                                                               
          MINLW=LWMNP                                                                                                               
      ELSE                                                                                                                          
          PUB=.FALSE.                                                                                                               
          DOTITLE=.TRUE.                                                                                                            
          DOINFOLABEL=.TRUE.                                                                                                        
          DOLGND=.TRUE.                                                                                                             
          DOLABEL=.TRUE.                                                                                                            
                                                                                                                                    
          IF(MS.EQ.1) THEN                                                                                                          
             DOTITLE=.FALSE.                                                                                                        
          ELSE IF(MS.EQ.2) THEN                                                                                                     
             DOINFOLABEL=.FALSE.                                                                                                    
          ELSE IF(MS.EQ.3) THEN                                                                                                     
             DOTITLE=.FALSE.                                                                                                        
             DOINFOLABEL=.FALSE.                                                                                                    
          ELSE IF(MS.EQ.4) THEN                                                                                                     
             DOTITLE=.FALSE.                                                                                                        
             DOINFOLABEL=.FALSE.                                                                                                    
             DOLGND=.FALSE.                                                                                                         
          ENDIF                                                                                                                     
          CALL GSLWSC(2.0)                                                                                                          
          MAJLW=LWMJ                                                                                                                
          MINLW=LWMN                                                                                                                
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C     * READ IN THE SHADING CARDS IF NEEDED AND SET THE CLRPLT                                                                      
C     * AND CLRINIT FLAGS APPROPRIATELY.                                                                                            
C                                                                                                                                   
      CLRPLT = .FALSE.                                                                                                              
      IF (ICOSH.EQ.1) THEN                                                                                                          
                                                                                                                                    
C     * CARD 3 ****************************************                                                                             
C     * UP TO 28 COLOURS                                                                                                            
C                                                                                                                                   
        READ(5,5056,END=904) WHITFG, NPAT, (IPAT(I),I=1,7)                                                                          
         WRITE(6,5156) WHITFG, NPAT, (IPAT(I),I=1,7)                                                                                
        IF (NPAT .GT. 7) THEN                                                                                                       
          READ(5,5055,END=904) (IPAT(I),I=8,14)                                                                                     
          WRITE(6,5055) (IPAT(I),I=8,14)                                                                                            
        ENDIF                                                                                                                       
        IF (NPAT .GT. 14) THEN                                                                                                      
          READ(5,5055,END=904) (IPAT(I),I=15,21)                                                                                    
          WRITE(6,5055) (IPAT(I),I=15,21)                                                                                           
        ENDIF                                                                                                                       
        IF (NPAT .GT. 21) THEN                                                                                                      
          READ(5,5055,END=904) (IPAT(I),I=22,NPAT)                                                                                  
          WRITE(6,5055) (IPAT(I),I=22,NPAT)                                                                                         
        ENDIF                                                                                                                       
                                                                                                                                    
                                                                                                                                    
C     * CARD 4 ****************************************                                                                             
C     * UP TO 28 LEVELS                                                                                                             
C                                                                                                                                   
        IF(NPAT.LE.7) THEN                                                                                                          
           READ(5,5057,END=904) (ZLEV(I),I=1,NPAT-1)                                                                                
        ELSE                                                                                                                        
           READ(5,5057,END=904) (ZLEV(I),I=1,7)                                                                                     
        ENDIF                                                                                                                       
        IF (NPAT .GT. 7.AND.NPAT.LE.14) THEN                                                                                        
          READ(5,5057,END=904) (ZLEV(I),I=8,13)                                                                                     
        ENDIF                                                                                                                       
        IF (NPAT .GT. 14.AND.NPAT.LE.21) THEN                                                                                       
          READ(5,5057,END=904) (ZLEV(I),I=8,14)                                                                                     
          READ(5,5057,END=904) (ZLEV(I),I=15,NPAT-1)                                                                                
        ENDIF                                                                                                                       
        IF (NPAT .GT. 21.AND.NPAT.LE.28) THEN                                                                                       
          READ(5,5057,END=904) (ZLEV(I),I=8,14)                                                                                     
          READ(5,5057,END=904) (ZLEV(I),I=15,21)                                                                                    
          READ(5,5057,END=904) (ZLEV(I),I=22,NPAT-1)                                                                                
        ENDIF                                                                                                                       
                                                                                                                                    
         WRITE(6,5157) (ZLEV(I),I=1,NPAT-1)                                                                                         
                                                                                                                                    
C                                                                                                                                   
C          * COLOUR SHADES ARE IN THE RANGE 100-199 SO TURN ON THE CLRPLT                                                           
C          * FLAG IF THE FIRST SHADING PATTERN IS IN THIS RANGE.                                                                    
C                                                                                                                                   
           IF (IPAT(1) .GE. 100 .AND. IPAT(1) .LE. 199) THEN                                                                        
                CLRPLT = .TRUE.                                                                                                     
                                                                                                                                    
                IF (.NOT. CLRINIT) THEN                                                                                             
                     IF(NPAT.GT.0) THEN                                                                                             
                       NCLRS=-NPAT                                                                                                  
                     ELSE                                                                                                           
                       NCLRS=0                                                                                                      
                     ENDIF                                                                                                          
                     CALL DFCLRS(NCLRS, HSVV,IPAT)                                                                                  
                     CLRINIT = .TRUE.                                                                                               
                ENDIF                                                                                                               
           ENDIF                                                                                                                    
      ENDIF                                                                                                                         
      CALL BFCRDF(0)                                                                                                                
      CALL PCSETI('CD', 1)                                                                                                          
      CALL GSTXFP(-12,2)                                                                                                            
      CALL PCSETI('OF', 1)                                                                                                          
      CALL PCSETI('OL', 2)                                                                                                          
      CALL PCSETR('CL',.2)                                                                                                          
                                                                                                                                    
C                                                                                                                                   
C     * FIND THE REQUESTED FIELD.                                                                                                   
C                                                                                                                                   
      IF(NAME.EQ.NC4TO8('NEXT'))THEN                                                                                                
        CALL GETFLD2(LUNFIELD1,SP,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                         
      ELSE                                                                                                                          
        CALL GETFLD2(LUNFIELD1,SP,NC4TO8('SPEC'),                                                                                   
     1        NSTEP,NAME,LEVEL,IBUF,MAXX,OK)                                                                                        
      ENDIF                                                                                                                         
      IF(.NOT.OK) CALL                             PXIT('SPPLOT',-1)                                                                
      IF(IBUF(8).LE.0) WRITE(6,6090) IBUF(8)                                                                                        
C                                                                                                                                   
      LRLMT=IBUF(7)                                                                                                                 
C     WRITE(6,*) 'TEST 1'                                                                                                           
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
C                                                                                                                                   
      IW=LM                                                                                                                         
      IF(KTR.EQ.2)THEN                                                                                                              
        IH=LM                                                                                                                       
      ELSE                                                                                                                          
        IH=2*LM                                                                                                                     
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * INITIALIZE BOX TO SPECIAL VALUE FOR CONREC.                                                                                 
C                                                                                                                                   
      DO 150 J=1,IH                                                                                                                 
      DO 150 I=1,IW                                                                                                                 
      IND=(J-1)*IW+I                                                                                                                
      BOX(IND)=SPVAL                                                                                                                
  150 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * FILL BOX.                                                                                                                   
C                                                                                                                                   
      DO 200 M=1,LM                                                                                                                 
        KL=LSR(1,M)                                                                                                                 
        KR=LSR(1,M+1)-1                                                                                                             
        DO 200 K=KL,KR                                                                                                              
          NS=(M-1)+(K-KL)                                                                                                           
          IF (M.NE.1.AND.ABS(ISCAL).EQ.2) SP(K)=SP(K)/2.                                                                            
          IND=NS*IW+M                                                                                                               
          IF(NS.EQ.0) GO TO 200                                                                                                     
          BOX(IND)=SCAL*REAL(SP(K))                                                                                                 
          IF (REAL(SP(K)).EQ.0.0) GO TO 200                                                                                         
          IF (ISCAL.LT.0) BOX(IND)=SCAL*LOG10(REAL(SP(K)))                                                                          
  200 CONTINUE                                                                                                                      
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C     * CHECK FOR HEMISPHERIC DATA                                                                                                  
C                                                                                                                                   
      IF (IHEM .NE. 0) THEN                                                                                                         
C                                                                                                                                   
C          * INTERPOLATION FOR HEMISPHERIC DATA                                                                                     
C                                                                                                                                   
C          * LOWER LEFT CORNER                                                                                                      
C                                                                                                                                   
           IF (BOX(LM + 1) .EQ. 0.0)                                                                                                
     1          BOX(LM + 1) = (BOX(2*LM + 1) + BOX(LM + 2))/2.0                                                                     
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C          * UPPER LEFT CORNER                                                                                                      
C                                                                                                                                   
           IF (BOX((LM - 1)*LM + 1) .EQ. 0.0)                                                                                       
     1          BOX((LM - 1)*LM + 1) = (BOX((LM - 2)*LM + 1) +                                                                      
     2                                  BOX((LM - 1)*LM + 2)                                                                        
     3                                 )/2.0                                                                                        
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C          * RIGHT-HAND CORNERS                                                                                                     
C                                                                                                                                   
           IF (BOX(LM*LM - 1) .EQ. 0.0)                                                                                             
     1          BOX(LM*LM - 1) = (BOX((LM - 1)*LM - 1) +                                                                            
     2                            BOX(LM*LM - 2)                                                                                    
     3                           )/2.0                                                                                              
                                                                                                                                    
           IF (KTR .EQ. 0 .AND. BOX((IH - 2)*IW) .EQ. 0.0)                                                                          
     1          BOX((IH - 2)*IW) = (BOX((IH - 2)*IW - 1) +                                                                          
     2                              BOX((IH - 3)*IW)                                                                                
     3                             )/2.0                                                                                            
                                                                                                                                    
           IF (KTR .EQ. 0 .AND. BOX(LM*IW) .EQ. 0.0)                                                                                
     1          BOX(LM*IW) = (BOX((LM + 1)*IW) + BOX(LM*IW - 1))/2.0                                                                
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C          * LEFT AND RIGHT EDGES                                                                                                   
C                                                                                                                                   
           LMM2=LM-2                                                                                                                
           DO 210 I=2,LMM2                                                                                                          
                IF (BOX(I*LM + 1) .EQ. 0.0)                                                                                         
     1               BOX(I*LM + 1) = (BOX((I - 1)*LM + 1) +                                                                         
     2                                BOX((I + 1)*LM + 1)                                                                           
     3                               )/2.0                                                                                          
                                                                                                                                    
                IF (KTR .EQ. 0 .AND. BOX((I - 1 + IW)*IW) .EQ. 0.0)                                                                 
     1               BOX((I - 1 + IW)*IW) = (BOX((I + IW)*IW) +                                                                     
     2                                       BOX((I-2+IW)*IW)                                                                       
     3                                      )/2.0                                                                                   
  210      CONTINUE                                                                                                                 
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C          * UPPER EDGE                                                                                                             
C                                                                                                                                   
           KL=(LM-1)*LM+2                                                                                                           
           KR=LM*LM-2                                                                                                               
           DO 220 I=KL,KR                                                                                                           
                IF (BOX(I) .EQ. 0.0)                                                                                                
     1               BOX(I) =(BOX(I - 1) + BOX(I + 1))/2.0                                                                          
  220      CONTINUE                                                                                                                 
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C     *      LOWER RIGHT AND UPPER LEFT EDGE                                                                                        
C                                                                                                                                   
           DO 230 I=1,LMM2                                                                                                          
                IF (BOX(I*LM + (I + 1)) .EQ. 0.0)                                                                                   
     1               BOX(I*LM + (I + 1)) = (BOX(I*LM + I) +                                                                         
     2                                      BOX((I + 1)*LM + (I + 1))                                                               
     3                                     )/2.0                                                                                    
                                                                                                                                    
                IF (KTR .NE. 0 .AND. BOX((I - 1)*IW + I + 1) .EQ. 0)                                                                
     1               BOX((I-1+IW)*IW+I+1) = (BOX((I-1)*IW+I+2) +                                                                    
     2                                       BOX((I-2+IW)*IW+I+1)                                                                   
     3                                      )/2.0                                                                                   
  230      CONTINUE                                                                                                                 
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C          * INTERIOR                                                                                                               
C                                                                                                                                   
           JLIM=I+LMM2                                                                                                              
           IF(KTR.EQ.2) JLIM=LMM2                                                                                                   
           LMM1=LM-1                                                                                                                
           DO 240 I = 2, LMM1                                                                                                       
                DO 241 J = I, JLIM                                                                                                  
                     IF (BOX(J*LM+I).EQ.0.0)                                                                                        
     1                    BOX(J*LM + I) = (BOX(J*LM + I + 1) +                                                                      
     2                                     BOX(J*LM + I - 1) +                                                                      
     3                                     BOX((J + 1)*LM + I) +                                                                    
     4                                     BOX((J - 1)*LM + I)                                                                      
     5                                    )/4.0                                                                                     
  241           CONTINUE                                                                                                            
  240      CONTINUE                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
                                                                                                                                    
C                                                                                                                                   
C     * ALL ELEMENTS IN BOX WHOSE VALUES ARE SPVAL WILL NOT HAVE CONTOURS DRAWN.                                                    
C                                                                                                                                   
      IOFFP=1                                                                                                                       
      NULBLL=1                                                                                                                      
C                                                                                                                                   
C     * PLOT.  MAKE LABELS INTEGERS ON PLOT                                                                                         
C                                                                                                                                   
      IOFFD=1                                                                                                                       
      IF(KTR.EQ.2) THEN                                                                                                             
                                                                                                                                    
C       * TRIANGULAR TRUNCATION                                                                                                     
                                                                                                                                    
C     WRITE(6,*) 'TEST 2'                                                                                                           
        CALL SET(.1,.9,.1,.9,.1,.9,.1,.9,1)                                                                                         
        NLM= (LM-1)*INCR+LM                                                                                                         
        CALL SPINTR(BOX,BOXNEW,LM,NLM,INCR,DUM1,DUM2,DUM3,DUM4,DUM5)                                                                
      ELSE                                                                                                                          
                                                                                                                                    
C     * RHOMBOIDAL TRUNCATION                                                                                                       
                                                                                                                                    
         TB=.9*FLOAT(2*LM+1)/FLOAT(2*LM)                                                                                            
         CALL SET(.1,.5,.1,TB,.1,.9,.1,.9,1)                                                                                        
C        * RHOMBOIDAL OPTION NOT IMPLEMENTED                                                                                        
         GOTO 905                                                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
                                                                                                                                    
      NWDS=NLM*NLM                                                                                                                  
C                                                                                                                                   
C     *  SET THE TENSION FOR THE CONTOUR LINE SMOOTHER                                                                              
C                                                                                                                                   
C     IF(NWDS.LT.500) THEN                                                                                                          
C        TENSN=30.0                                                                                                                 
C     ELSEIF(500.LT.NWDS.AND.NWDS.LT.2000) THEN                                                                                     
C        TENSN=39.16666667 - 0.018333333*FLOAT(NWDS)                                                                                
C     ELSE                                                                                                                          
C        TENSN=2.5                                                                                                                  
C     ENDIF                                                                                                                         
C     IF ( TENSN.GT.9.0) TENSN=9.0                                                                                                  
                                                                                                                                    
C                                                                                                                                   
C     * DRAW THE CONTOUR LINES.                                                                                                     
C                                                                                                                                   
      NDOT = -987                                                                                                                   
C                                                                                                                                   
C     * CALCULATE PT(3,3)                                                                                                           
C                                                                                                                                   
      PT = BOXNEW(NLM*2+3)                                                                                                          
      write(6,*) 'PT: ',PT                                                                                                          
C                                                                                                                                   
C     * SHADE THE PLOT                                                                                                              
C                                                                                                                                   
C           CALL HAFTON(BOXNEW,NLM,NLM,NLM,FLO,FHI,NPAT,0,-1,1,SPVAL)                                                               
C                                                                                                                                   
C     * IF LHI >= 0, HIGHS AND LOWS LABELLED,                                                                                       
C              < 0, .. NOT LABELLED.                                                                                                
C                                                                                                                                   
      CALL BFCRDF(0)                                                                                                                
      IF (LHI.GE.0) CALL CPSETC('HLT',                                                                                              
     1              'H:B:$ZDV$:E:''L:B:$ZDV$:E:')                                                                                   
      IF (LHI.LT.0) CALL CPSETC('HLT',' '' ')                                                                                       
C     * Set special value SPVAL=1.0E38                                                                                              
      CALL CPSETR('SPV', SPVAL)                                                                                                     
C                                                                                                                                   
C     * SHADING                                                                                                                     
C                                                                                                                                   
      CALL CONTDF(PUB)                                                                                                              
      IF (ICOSH.EQ.1) THEN                                                                                                          
C     WRITE(6,*) 'TEST 3'                                                                                                           
                                                                                                                                    
         CALL ARINAM(SP_MAP,SP_MAP_SIZE)                                                                                            
         CALL CPRECT(BOXNEW,NLM,NLM,NLM,RWRK,LRWK,IWRK,LIWK)                                                                        
         CALL CPCLAM(BOXNEW,RWRK,IWRK,SP_MAP)                                                                                       
         CALL GSLWSC(1.)                                                                                                            
         CALL ARSCAM(SP_MAP,XWRK,YWRK,NWRK,IAREA,IGRP,                                                                              
     1        NOGRPS,PATTERN)                                                                                                       
         CALL CPSETI('LBC',0)                                                                                                       
         IF (.NOT.CLRPLT) THEN                                                                                                      
            CALL CPSETI('LLB',2)                                                                                                    
            CALL CPSETI('HLB',2)                                                                                                    
         ENDIF                                                                                                                      
         CALL GSLWSC(1.5)                                                                                                           
         IF (DOLGND) CALL SP_LEGEND(CLRPLT)                                                                                         
      ENDIF                                                                                                                         
                                                                                                                                    
                                                                                                                                    
      CALL ARINAM(SP_MAP,SP_MAP_SIZE)                                                                                               
      CALL CPRECT(BOXNEW,NLM,NLM,NLM,RWRK,LRWK,IWRK,LIWK)                                                                           
C                                                                                                                                   
C     * SET CONTOURING PARAMETERS                                                                                                   
C                                                                                                                                   
C     WRITE(6,*) 'TEST 4'                                                                                                           
      CALL CONLS(FLO, FHI, FINC, LAB_FLAG, PUB, FHIGHN, FLOWN)                                                                      
      TOL = ABS(FINC/10.0)                                                                                                          
                                                                                                                                    
      CALL CPGETI('NCL - NUMBER OF CONTOUR LEVELS', NCL)                                                                            
      DO I=1,NCL                                                                                                                    
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)                                                                              
         IF(PUB) THEN                                                                                                               
            CALL CPSETI('CLU', 1)                                                                                                   
            CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',3.)                                                                         
         ELSE                                                                                                                       
            CALL CPSETI('CLU', 3)                                                                                                   
            CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',2.)                                                                         
         ENDIF                                                                                                                      
      ENDDO                                                                                                                         
C Set thick/thin contours                                                                                                           
         CALL CONCN(FHIGHN, FLOWN, FINC, PUB, DOLABEL)                                                                              
         IF (INZERO .GT. 0) THEN                                                                                                    
            CALL CPSETI('PAI - PARAMETER ARRAY INDEX', INZERO)                                                                      
            CALL CPSETI('CLU', 0)                                                                                                   
            CALL CPSETR('CLL', 0)                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C     * CONTOUR                                                                                                                     
C                                                                                                                                   
CDEBUG                                                                                                                              
CCCC           CALL CPGETI('NCL - NUMBER OF CONTOUR LEVELS', NCL)                                                                   
CCCC           DO I=1,NCL                                                                                                           
CCCC              CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)                                                                     
CCCC              CALL CPGETR('CLV - CONTOUR LEVEL VALUES',FLVAL)                                                                   
CCCC              CALL CPGETR('CLL - CONTOUR LINE LINE WIDTH',RLW)                                                                  
CCCC              CALL CPSETI('CLU', 3)                                                                                             
CCCC              CALL CPGETI('CLU', ICLU)                                                                                          
CCCC              CALL CPGETC('LLT - LINE LABEL TEXT STRING',LLTXT)                                                                 
CCCC              WRITE(*,*) I,FLVAL,RLW,ICLU,'"',LLTXT,'"'                                                                         
CCCC           ENDDO                                                                                                                
CDEBUG                                                                                                                              
                                                                                                                                    
      CALL GSLWSC(2.)                                                                                                               
C     WRITE(6,*) 'TEST 5'                                                                                                           
                                                                                                                                    
      CALL CPLBAM(BOXNEW, RWRK, IWRK, SP_MAP)                                                                                       
C     WRITE(6,*) 'TEST 5.1'                                                                                                         
                                                                                                                                    
      CALL CPCLDM(BOXNEW, RWRK, IWRK, SP_MAP, CPDRPL)                                                                               
C     WRITE(6,*) 'TEST 5.2'                                                                                                         
                                                                                                                                    
      CALL CPLBDR(BOXNEW, RWRK, IWRK)                                                                                               
C     WRITE(6,*) 'TEST 5.3'                                                                                                         
                                                                                                                                    
C      IF (LHI .GT. 0) LHI=0                                                                                                        
C      CALL CPCNRC(BOXNEW,NLM,NLM,NLM,FLO,FHI,FINC,-1,LHI,NDOT)                                                                     
                                                                                                                                    
C                                                                                                                                   
C     * SET THE POLYLINE COLOUR INDEX AND THE TEXT COLOUR INDEX BACK TO                                                             
C     * THE FOREGROUND COLOUR FOR THE REST OF THE GRAPH.                                                                            
C                                                                                                                                   
C      IF (CLRPLT) THEN                                                                                                             
C           CALL GSPLCI(1)                                                                                                          
C           CALL GSTXCI(1)                                                                                                          
C      ENDIF                                                                                                                        
C                                                                                                                                   
C     * WRITE LABEL. ROUTINE SHORTN CENTRES IT.                                                                                     
C                                                                                                                                   
      IF(DOTITLE) THEN                                                                                                              
C     WRITE(6,*) 'TEST 5.4'                                                                                                         
                                                                                                                                    
         CALL GSLWSC(2.0)                                                                                                           
C     WRITE(6,*) 'TEST 5.5'                                                                                                         
                                                                                                                                    
         CALL SET(0.0, 1.0, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0, 1)                                                                        
C     WRITE(6,*) 'TEST 5.6'                                                                                                         
                                                                                                                                    
      X = 0.50                                                                                                                      
      Y = 1.0 - (CHRATIO - 1.0)*CPFY(ITSIZ) - CPFY(ITSIZ/2)                                                                         
      LEAD=.TRUE.                                                                                                                   
      TRAIL=.TRUE.                                                                                                                  
C     WRITE(6,*) 'TEST 5.7'                                                                                                         
                                                                                                                                    
      CALL SHORTN(LABEL,83,LEAD,TRAIL,NC)                                                                                           
C                                                                                                                                   
C     * ADJUST THE CHARACTER SIZE FOR THE TITLE, DEPENDING ON THE LENGTH.                                                           
C     * NOTE: THIS MAGIC FORMULA WAS DETERMINED ENTIRELY FROM EXPERIMENTATION.                                                      
C     * SINCE CHARACTER WIDTHS WILL VARY FOR PCHIQU, THERE IS NO REAL WAY                                                           
C     * OF DETERMINING HOW SCALING SHOULD DONE BUT I FOUND THAT THIS FORMULA                                                        
C     * USUALLY WORKS.                                                                                                              
C                                                                                                                                   
         IF (NC - 3 .GT. INT(1024/(ITSIZ - 1))) THEN                                                                                
            IHGT = INT(1024/(NC - 3)) + 1                                                                                           
         ELSE                                                                                                                       
            IHGT = ITSIZ                                                                                                            
         ENDIF                                                                                                                      
                                                                                                                                    
C        PRINT *, 'X,Y: ', X, Y, IHGT, ' ', ALABEL                                                                                  
C        CHSIZE=1.0/85.0                                                                                                            
         CHSIZE=1.0*IHGT                                                                                                            
C     WRITE(6,*) 'TEST 6'                                                                                                           
                                                                                                                                    
          CALL PCHIQU(X,Y,ALABEL(4:NC),CHSIZE,0.,0.)                                                                                
C     WRITE(6,*) 'TEST 6.1'                                                                                                         
                                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C     * DRAW PERIMETER.                                                                                                             
C                                                                                                                                   
      CALL SET(.1,.9,.1,.9,.1,.9,.1,.9,1)                                                                                           
      CHSIZE=1.0*ISIZ                                                                                                               
      IF(KTR.NE.2) THEN                                                                                                             
           CALL FRSTPT(.1,.5)                                                                                                       
           CALL VECTOR(.1,.1)                                                                                                       
           CALL FRSTPT(.5,.9)                                                                                                       
           CALL VECTOR(.5,.5)                                                                                                       
                                                                                                                                    
           DO 260 I=1,LM                                                                                                            
                X=.1+FLOAT(I-1)*.4/FLOAT(LM-1)                                                                                      
                YD=X                                                                                                                
                XN=.1+FLOAT(I)*.4/FLOAT(LM-1)                                                                                       
                YN=XN                                                                                                               
                IF(I.EQ.LM)THEN                                                                                                     
                  XN=X                                                                                                              
                  YN=YD                                                                                                             
                ENDIF                                                                                                               
                                                                                                                                    
                CALL FRSTPT(X,YD-.005)                                                                                              
                CALL VECTOR(X,YN)                                                                                                   
                CALL VECTOR(XN,YN)                                                                                                  
                                                                                                                                    
                IL=(I-1)/10                                                                                                         
C     WRITE(6,*) 'TEST 6.2'                                                                                                         
                                                                                                                                    
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(X,YD-.03,LWN(IL+1),CHSIZE,0.,0.)                                                                   
                                                                                                                                    
                XL=.1                                                                                                               
                CALL FRSTPT(XL,YD)                                                                                                  
                CALL VECTOR(XL-.01,YD)                                                                                              
C     WRITE(6,*) 'TEST 6.3'                                                                                                         
                                                                                                                                    
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(XL-.03,YD,LWN(IL+1),CHSIZE,0.,0.)                                                                  
                                                                                                                                    
                YT=YD+.4                                                                                                            
                CALL FRSTPT(X,YT)                                                                                                   
                YN=XN+.4                                                                                                            
                CALL VECTOR(XN,YT)                                                                                                  
                CALL VECTOR(XN,YN+.005)                                                                                             
C     WRITE(6,*) 'TEST 6.4'                                                                                                         
                                                                                                                                    
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(X,YT+.03,LWN(IL+1),CHSIZE,0.,0.)                                                                   
                                                                                                                                    
                XR=X+.4                                                                                                             
                CALL FRSTPT(.5,YT)                                                                                                  
                CALL VECTOR(.5+.01,YT)                                                                                              
                                                                                                                                    
                IN=(I+LM-2)/10                                                                                                      
C                     WRITE(6,*) 'TEST 7'                                                                                           
                                                                                                                                    
                IF(10*IN.EQ.I+LM-2)                                                                                                 
     1               CALL PCHIQU(.5+.03,YT,LWN(IN+1),CHSIZE,0.,0.)                                                                  
                                                                                                                                    
  260      CONTINUE                                                                                                                 
                                                                                                                                    
      ELSE                                                                                                                          
C                                                                                                                                   
           CALL FRSTPT(.9,.9)                                                                                                       
           CALL VECTOR(.1,.9)                                                                                                       
           CALL VECTOR(.1,.1)                                                                                                       
           CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)                                                                                      
                                                                                                                                    
           DO 350 I=1,LM                                                                                                            
                X=.1+FLOAT(I-1)*.8/FLOAT(LM-1)                                                                                      
                YD=X                                                                                                                
                XN=.1+FLOAT(I)*.8/FLOAT(LM-1)                                                                                       
                YN=XN                                                                                                               
                                                                                                                                    
                IF(I.EQ.LM)THEN                                                                                                     
                  XN=X                                                                                                              
                  YN=YD                                                                                                             
                ENDIF                                                                                                               
                                                                                                                                    
                CALL FRSTPT(X,YD-.005)                                                                                              
                CALL VECTOR(X,YN)                                                                                                   
                CALL VECTOR(XN,YN)                                                                                                  
                                                                                                                                    
                IL=(I-1)/10                                                                                                         
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(X,YD-.03,LWN(IL+1),CHSIZE,0.,0.)                                                                   
                                                                                                                                    
                XL=.1                                                                                                               
                CALL FRSTPT(XL,YD)                                                                                                  
                CALL VECTOR(XL-.01,YD)                                                                                              
                                                                                                                                    
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(XL-.03,YD,LWN(IL+1),CHSIZE,0.,0.)                                                                  
                                                                                                                                    
                YT=.9                                                                                                               
                CALL FRSTPT(X,YT)                                                                                                   
                CALL VECTOR(X,YT+.01)                                                                                               
C     WRITE(6,*) 'TEST 8'                                                                                                           
                                                                                                                                    
                IF(10*IL.EQ.I-1)                                                                                                    
     1               CALL PCHIQU(X,YT+.03,LWN(IL+1),CHSIZE,0.,0.)                                                                   
  350      CONTINUE                                                                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * LAST LINE DRAWN                                                                                                             
C                                                                                                                                   
C     WRITE(6,*) 'TEST 9'                                                                                                           
                                                                                                                                    
      IF (DOINFOLABEL) THEN                                                                                                         
         WRITE(INFOLABEL,7010) FLO,FHI,FINC,PT                                                                                      
         CALL PCHIQU(.5,0.04,INFOLABEL,.007,0.,0.)                                                                                  
      ENDIF                                                                                                                         
C     WRITE(6,*) 'TEST 10'                                                                                                          
                                                                                                                                    
      CALL FRAME                                                                                                                    
      WRITE(6,6010) NSTEP,NAME,LEVEL,SCAL,FLO,FHI,FINC                                                                              
      WRITE(6,6020) (IBUF(I),I=1,8)                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * .E.O.F ON INPUT.                                                                                                            
C                                                                                                                                   
  901 CONTINUE                                                                                                                      
      CALL                                         PXIT('SPPLOT',0)                                                                 
  902 CALL                                         PXIT('SPPLOT',-2)                                                                
  903 CALL                                         PXIT('SPPLOT',-101)                                                              
  904 CALL                                         PXIT('SPPLOT',-102)                                                              
  905 CALL                                         PXIT('SPPLOT',-103)                                                              
C-----------------------------------------------------------------------                                                            
 5010 FORMAT(10X,I10,1X,A4,I5,4E10.0,I1,2I2,1X,2I2)                                                                                 
 5012 FORMAT(80A1)                                                                                                                  
 5055 FORMAT(15X,7I5)                                                                                                               
 5056 FORMAT(10X,I1,I4,7I5)                                                                                                         
 5057 FORMAT(10X,7E10.0)                                                                                                            
 5156 FORMAT('SHADING   ',I1,I4,7I5)                                                                                                
 5157 FORMAT('VALUES    ',7G10.4)                                                                                                   
 6010 FORMAT(5X,I10,1X,A4,I5,4E10.3,' REQUESTED')                                                                                   
 6020 FORMAT(1X,A4,I10,1X,A4,5I5,' PLOTTED')                                                                                        
 6090 FORMAT(/,' *** WARNING: PACKING DENSITY = ', I4,' ***',/)                                                                     
 7010    FORMAT("CONTOUR FROM ",F10.03,"    TO ",F10.03,                                                                            
     1        "   CONTOUR INTERVAL OF ",F10.03,                                                                                     
     2        "   PT(3,3)= ",G10.04)                                                                                                
      END                                                                                                                           
