C
C $Id: stitle.f,v 1.9 2008-07-27 00:17:27 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE STITLE (CRDS,NCDS,IYST,IYND,TMST,TMMV,TMND,MTST)
C
C The routine STITLE is given information defining a group of titles
C on a "scroll" that is 1023 units wide by 99,998 units high.  (X
C coordinates on the scroll run from 1 to 1024, while Y coordinates
C run from 1 to 99,999.)  Using this information, STITLE creates
C frames, for use in a movie, showing the titles scrolling by.
C
C Each element of the array CRDS defines the text of one title line and
C its desired X/Y position, color, centering, and character size.  The
C frames generated by STITLE show what lies within a viewport centered
C at (512,IYCN) on the scroll, where IYCN is equal to IYST for the first
C TMST seconds, changes linearly toward the value IYND over the next
C TMMV seconds, and then holds with IYCN equal to IYND for the last
C TMND seconds.
C
C The argument MTST may be set non-zero to request a set of test frames
C in place of the movie frames themselves.
C
C The behavior of STITLE is affected not only by the values of its
C arguments, but by the values of a number of "internal parameters":
C variables in common blocks of STITLE.  For example, there is an
C internal parameter, known by the name 'FIN', which specifies the
C number of seconds during which the titles "fade in" at the position
C IYCN = IYST, and another, known by the name 'FOU', which specifies
C the number of seconds during which the titles "fade out" at the
C position IYCN = IYND.
C
C See the STITLE programmer document for complete information.
C
        CHARACTER*(*) CRDS(NCDS)
C
C The common block SLCOMN holds all of the internal parameters of
C the package STITLE except for color-table parameters.
C
        COMMON /SLCOMN/ GPSZ,IBGC,IBGF,ICOP,IDOT,IFGC,IFGF,IJMP,IMAP,
     +                  INCU,IWLU,IWRK,IWWI,IXND,IXST,OORV,PCSZ,RNFS,
     +                  RVPB,RVPL,RVPR,RVPT,TFIN,TFOU,TGP1,TGP2,TGP3
        SAVE   /SLCOMN/
C
C The common block SLCLRS holds color-table parameters.
C
        COMMON /SLCLRS/ CRED(256),CGRN(256),CBLU(256),LOCI(256),NOCI
        SAVE   /SLCLRS/
C
C The common block PCSTCM is used to communicate the variables defining
C the STITLE viewport to PLOTCHAR so that titles can be clipped.
C
        COMMON /PCSTCM/ XVPL,XVPR,YVPB,YVPT
        SAVE   /PCSTCM/
C
C Declare a temporary variable in which to form complete output lines.
C
        CHARACTER*500 CTMP
C
C Declare a temporary variable in which to receive the GKS clipping
C rectangle.
C
        DIMENSION CRCT(4)
C
C Declare a couple of arrays in which to define the coordinates of the
C corners of the plotter frame for the GPM calls below.
C
        DIMENSION XCPF(4),YCPF(4)
C
C Define a character variable in which messages may be formed.
C
        CHARACTER*42 CMSG
C
C Declare the type of the function SLSTLN, which finds the length of
C a character string, not counting terminal blanks.
C
        INTEGER SLSTLN
C
C Define the corners of the plotter frame for the GPM calls below.
C
        DATA XCPF(1),XCPF(2),XCPF(3),XCPF(4) / 0. , 1. , 1. , 0. /
        DATA YCPF(1),YCPF(2),YCPF(3),YCPF(4) / 0. , 0. , 1. , 1. /
C
C Define an arithmetic statement function that, given an X or Y plotter
C coordinate as its integer argument, returns the equivalent fractional
C coordinate as its value.  This is done instead of calling CPFX and
C CPFY because it is more efficient and because it avoids problems due
C to a possible user call to the old routine SETI.
C
        FRCT(IARG)=(IARG-1)/1023.
C
C Do a call forcing a BLOCKDATA to be loaded from a binary library.
C
        CALL SLBLDA
C
C Check for an uncleared prior error.
C
        IF (ICFELL('STITLE - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If the card buffer is empty, there's nothing to do, so quit.
C
        IF (NCDS.LE.0) RETURN
C
C Find out how long each "card image" is.
C
        LCRD=LEN(CRDS(1))
C
C ICNX is the X-coordinate of the center of the window, in the plotter
C coordinate system.
C
        ICNX=1+INT(.5*(RVPL+RVPR)*1023.)
C
C ICNY is the Y-coordinate of the center of the window, in the plotter
C coordinate system.
C
        ICNY=1+INT(.5*(RVPB+RVPT)*1023.)
C
C IHHW is half the height of the window, in the plotter coordinate
C system.
C
        IHHW=.5*(RVPT-RVPB)*1023.
C
C Compute the multiplicative constant required to make PLCHHQ give
C characters of a desired size.
C
        FPMC=(6./7.)*PCSZ/1023.
C
C Save the current GKS clipping indicator, and then set clipping off.
C (All necessary clipping is done by PLOTCHAR.)
C
        CALL GQCLIP (IERR,ISCI,CRCT)
        IF (IERR.NE.0) THEN
          CMSG(1:34)='STITLE - ERROR RETURN FROM GQCLIP:'
          WRITE (CMSG(35:42),'(I8)') IERR
          CALL SETER (CMSG(1:42),2,1)
          RETURN
        END IF
        CALL GSCLIP (0)
C
C Save the current normalization transformation number and reset to use
C normalization transformation 0.  This allows us to use X/Y coordinates
C in the fractional system (NDCs).
C
        CALL GQCNTN (IERR,ISNT)
        IF (IERR.NE.0) THEN
          CMSG(1:34)='STITLE - ERROR RETURN FROM GQCNTN:'
          WRITE (CMSG(35:42),'(I8)') IERR
          CALL SETER (CMSG(1:42),3,1)
          RETURN
        END IF
        CALL GSELNT (0)
C
C Save the current polyline, polymarker, and text color indices and set
C all of them to the default foreground color.
C
        CALL GQPLCI (IERR,ISPL)
        IF (IERR.NE.0) THEN
          CMSG(1:34)='STITLE - ERROR RETURN FROM GQPLCI:'
          WRITE (CMSG(35:42),'(I8)') IERR
          CALL SETER (CMSG(1:42),4,1)
          RETURN
        END IF
        CALL GSPLCI (IFGC)
C
        CALL GQPMCI (IERR,ISPM)
        IF (IERR.NE.0) THEN
          CMSG(1:34)='STITLE - ERROR RETURN FROM GQPMCI:'
          WRITE (CMSG(35:42),'(I8)') IERR
          CALL SETER (CMSG(1:42),5,1)
          RETURN
        END IF
        CALL GSPMCI (IFGC)
C
        CALL GQTXCI (IERR,ISTX)
        IF (IERR.NE.0) THEN
          CMSG(1:34)='STITLE - ERROR RETURN FROM GQTXCI:'
          WRITE (CMSG(35:42),'(I8)') IERR
          CALL SETER (CMSG(1:42),6,1)
          RETURN
        END IF
        CALL GSTXCI (IFGC)
C
C Open WISS for GFLASH.
C
        CALL GOPWK (IWWI,IWLU,3)
C
C Save the current value of the PLOTCHAR character-color parameter for
C later restoration.
C
        CALL PCGETI ('CC',ISCC)
        IF (ICFELL('STITLE',7).NE.0) RETURN
C
C Set all the parameters required to make PLOTCHAR do clipping (saving
C the original values for later restoration).
C
        IF (IMAP.GT.0) THEN
          CALL PCGETI ('MA',ISMA)
          IF (ICFELL('STITLE',8).NE.0) RETURN
          CALL PCSETI ('MA',IMAP)
          IF (ICFELL('STITLE',9).NE.0) RETURN
        END IF
C
        IF (OORV.NE.0.) THEN
          CALL PCGETR ('OR',RSOR)
          IF (ICFELL('STITLE',10).NE.0) RETURN
          CALL PCSETR ('OR',OORV)
          IF (ICFELL('STITLE',11).NE.0) RETURN
        END IF
C
        XVPL=RVPL
        XVPR=RVPR
        YVPB=RVPB
        YVPT=RVPT
C
C Make sure color indices IBGC and IFGC and all color indices mentioned
C in the card input are among those defined by the STITLE color table.
C (Requesting the RGB components forces them to be defined if they
C hadn't been already.)  These calls have the side effect of causing
C the common variable IWRK to be defined, as well.
C
        CALL SLGCLR (IBGC,BRED,BGRN,BBLU)
        IF (ICFELL('STITLE',12).NE.0) RETURN
C
        CALL SLGCLR (IFGC,FRED,FGRN,FBLU)
        IF (ICFELL('STITLE',13).NE.0) RETURN
C
        DO 101 I=1,NCDS
          READ (CRDS(I)(1:13),'(2I5,I3)') IXPS,IYPS,ICLR
          IF (IXPS.NE.-9999) THEN
            CALL SLGCLR (MAX(1,ICLR),FRED,FGRN,FBLU)
            IF (ICFELL('STITLE',14).NE.0) RETURN
          END IF
  101   CONTINUE
C
C Make sure all the colors defined by the STITLE color table are still
C defined as such for GKS.
C
        DO 102 IOCI=1,NOCI
          CALL SLGCLR (LOCI(IOCI),FRED,FGRN,FBLU)
          IF (ICFELL('STITLE',15).NE.0) RETURN
          CALL GSCR (IWRK,LOCI(IOCI),FRED,FGRN,FBLU)
  102   CONTINUE
C
C If it has been requested, dot the corners of an initial frame (for
C splicing purposes - useless now, I suppose).
C
        IF (IDOT.NE.0) THEN
          CALL GPM (4,XCPF,YCPF)
          IF (MTST.NE.0.OR.IDOT.GT.1) THEN
            CALL WTSTR (.5,.5,'ALIGNMENT FRAME',2,0,0)
            IF (ICFELL('STITLE',16).NE.0) RETURN
          END IF
          CALL SLFRME
          IF (ICFELL('STITLE',17).NE.0) RETURN
        END IF
C
C Fade-in at start.
C
        IF (TFIN.NE.0.) THEN
C
          NREP=MAX(1,INT(TFIN*RNFS+.5))
          IF (MTST.NE.0) NREP=1
C
          IF (IBGF.GE.0.AND.IBGF/1000.NE.999) THEN
            CALL SLGCLR (IBGF/1000,BFIR,BFIG,BFIB)
            IF (ICFELL('STITLE',18).NE.0) RETURN
          END IF
C
          IF (IFGF.GE.0.AND.IFGF/1000.NE.999) THEN
            CALL SLGCLR (IFGF/1000,FFIR,FFIG,FFIB)
            IF (ICFELL('STITLE',19).NE.0) RETURN
          END IF
C
          DO 107 IREP=1,NREP
C
            DO 103 IOCI=1,NOCI
              CALL SLGCLR (LOCI(IOCI),FRED,FGRN,FBLU)
              IF (ICFELL('STITLE',20).NE.0) RETURN
              IF      ((LOCI(IOCI).EQ.IBGC.AND.IBGF.EQ.-2).OR.
     +                 (LOCI(IOCI).NE.IBGC.AND.IFGF.EQ.-2)) THEN
                CALL RGBHSV (FRED,FGRN,FBLU,H,S,V)
                IF (ICFELL('STITLE',21).NE.0) RETURN
                CALL HSVRGB (H,S,REAL(IREP)*V/REAL(NREP),FRED,FGRN,FBLU)
                IF (ICFELL('STITLE',22).NE.0) RETURN
              ELSE IF (LOCI(IOCI).EQ.IBGC.AND.IBGF.GE.0.AND.
     +                                            IBGF/1000.NE.999) THEN
                FRED=(REAL(NREP-IREP)*BFIR+REAL(IREP)*FRED)/REAL(NREP)
                FGRN=(REAL(NREP-IREP)*BFIG+REAL(IREP)*FGRN)/REAL(NREP)
                FBLU=(REAL(NREP-IREP)*BFIB+REAL(IREP)*FBLU)/REAL(NREP)
              ELSE IF (LOCI(IOCI).NE.IBGC.AND.IFGF.GE.0.AND.
     +                                            IFGF/1000.NE.999) THEN
                FRED=(REAL(NREP-IREP)*FFIR+REAL(IREP)*FRED)/REAL(NREP)
                FGRN=(REAL(NREP-IREP)*FFIG+REAL(IREP)*FGRN)/REAL(NREP)
                FBLU=(REAL(NREP-IREP)*FFIB+REAL(IREP)*FBLU)/REAL(NREP)
              END IF
              CALL GSCR (IWRK,LOCI(IOCI),FRED,FGRN,FBLU)
  103       CONTINUE
C
            IF (IBGC.NE.0) THEN
              CALL SLBKGD
              IF (ICFELL('STITLE',23).NE.0) RETURN
            END IF
C
            CALL SLUBKG (-1)
            IF (ICFELL('STITLE',24).NE.0) RETURN
C
            DO 106 I=1,NCDS
              READ (CRDS(I)(1:20),'(2I5,I3,I2,F5.1)')
     +                                          IXPS,IYPS,ICLR,ICNT,SIZE
              IF (IXPS.EQ.-9999) GO TO 106
              NOCH=MIN(500,SLSTLN(CRDS(I)(21:LCRD)))
              CTMP=CRDS(I)(21:20+NOCH)
              DO 104 J=I+1,NCDS
                IF (CRDS(J)(1:5).NE.'-9999') GO TO 105
                NACH=MIN(500-NOCH,SLSTLN(CRDS(J)(21:LCRD)))
                IF (NACH.NE.0) THEN
                  CTMP(NOCH+1:NOCH+NACH)=CRDS(J)(21:20+NACH)
                  NOCH=NOCH+NACH
                END IF
  104         CONTINUE
  105         CALL PCSETI ('CC (CHARACTER COLOR)',MAX(1,ICLR))
              IF (ICFELL('STITLE',25).NE.0) RETURN
              CALL PLCHHQ (FRCT(IXPS-IXST+ICNX),FRCT(IYPS-IYST+ICNY),
     +                     CTMP(1:NOCH),FPMC*SIZE,0.,REAL(ICNT-1))
              IF (ICFELL('STITLE',26).NE.0) RETURN
  106       CONTINUE
C
            CALL SLUBKG (+1)
            IF (ICFELL('STITLE',27).NE.0) RETURN
C
            IF (MTST.NE.0) THEN
              CALL SLOWND
              IF (ICFELL('STITLE',28).NE.0) RETURN
              WRITE (CMSG(1:8),'(F8.2)') TFIN
              CMSG(9:24)=' SECS OF FADE IN'
              CALL SLPWRV (.98,.5,CMSG(1:24),.016)
              IF (ICFELL('STITLE',29).NE.0) RETURN
            END IF
C
            CALL SLFRME
            IF (ICFELL('STITLE',30).NE.0) RETURN
C
  107     CONTINUE
C
        END IF
C
C Stationary frames at start.
C
        IF (TMST.NE.0.) THEN
C
          CALL GFLAS1 (IWWI)
          IF (ICFELL('STITLE',31).NE.0) RETURN
C
          IF (IBGC.NE.0) THEN
            CALL SLBKGD
            IF (ICFELL('STITLE',32).NE.0) RETURN
          END IF
C
          CALL SLUBKG (-2)
          IF (ICFELL('STITLE',33).NE.0) RETURN
C
          DO 110 I=1,NCDS
            READ (CRDS(I)(1:20),'(2I5,I3,I2,F5.1)')
     +                                          IXPS,IYPS,ICLR,ICNT,SIZE
            IF (IXPS.EQ.-9999) GO TO 110
            NOCH=MIN(500,SLSTLN(CRDS(I)(21:LCRD)))
            CTMP=CRDS(I)(21:20+NOCH)
            DO 108 J=I+1,NCDS
              IF (CRDS(J)(1:5).NE.'-9999') GO TO 109
              NACH=MIN(500-NOCH,SLSTLN(CRDS(J)(21:LCRD)))
              IF (NACH.NE.0) THEN
                CTMP(NOCH+1:NOCH+NACH)=CRDS(J)(21:20+NACH)
                NOCH=NOCH+NACH
              END IF
  108       CONTINUE
  109       CALL PCSETI ('CC (CHARACTER COLOR)',MAX(1,ICLR))
            IF (ICFELL('STITLE',34).NE.0) RETURN
            CALL PLCHHQ (FRCT(IXPS-IXST+ICNX),FRCT(IYPS-IYST+ICNY),
     +                   CTMP(1:NOCH),FPMC*SIZE,0.,REAL(ICNT-1))
            IF (ICFELL('STITLE',35).NE.0) RETURN
  110     CONTINUE
C
          CALL SLUBKG (+2)
          IF (ICFELL('STITLE',36).NE.0) RETURN
C
          CALL GFLAS2
          IF (ICFELL('STITLE',37).NE.0) RETURN
C
          NREP=MAX(1,INT(TMST*RNFS+.5))
          IF (MTST.NE.0) NREP=1
C
          DO 111 I=1,NREP
            CALL GFLAS3 (IWWI)
            IF (ICFELL('STITLE',38).NE.0) RETURN
            IF (MTST.NE.0) THEN
              CALL SLOWND
              IF (ICFELL('STITLE',39).NE.0) RETURN
              WRITE (CMSG(1:8),'(F8.2)') TMST
              CMSG(9:22)=' SECS AT START'
              CALL SLPWRV (.98,.5,CMSG(1:22),.016)
              IF (ICFELL('STITLE',40).NE.0) RETURN
            END IF
            CALL SLFRME
            IF (ICFELL('STITLE',41).NE.0) RETURN
  111     CONTINUE
C
        END IF
C
C Moving portion.  Note the inclusion of a test to prevent PLCHHQ from
C being called if it is not possible that any portion of the line is
C visible in the viewport.
C
        IF (TMMV.NE.0.) THEN
C
          NDIF=INT(TMMV*RNFS+.5)
          IF (MTST.NE.0) NDIF=MAX(1,ABS(IYND-IYST)/IJMP)
C
          TPER=TMMV/REAL(NDIF)
C
          DIFX=REAL(IXND-IXST)/REAL(NDIF)
          DIFY=REAL(IYND-IYST)/REAL(NDIF)
C
          NDIF=NDIF+1
C
          TFRA=0.
C
          DO 115 K=1,NDIF
C
            LXPS=ICNX-IXST-INT(REAL(K-1)*DIFX)
            LYPS=ICNY-IYST-INT(REAL(K-1)*DIFY)
C
            IF (IBGC.NE.0) THEN
              CALL SLBKGD
              IF (ICFELL('STITLE',42).NE.0) RETURN
            END IF
C
            CALL SLUBKG (-3)
            IF (ICFELL('STITLE',43).NE.0) RETURN
C
            DO 114 I=1,NCDS
              READ (CRDS(I)(1:20),'(2I5,I3,I2,F5.1)')
     +                                          IXPS,IYPS,ICLR,ICNT,SIZE
              IF (IXPS.EQ.-9999) GO TO 114
              NOCH=MIN(500,SLSTLN(CRDS(I)(21:LCRD)))
              CTMP=CRDS(I)(21:20+NOCH)
              DO 112 J=I+1,NCDS
                IF (CRDS(J)(1:5).NE.'-9999') GO TO 113
                NACH=MIN(500-NOCH,SLSTLN(CRDS(J)(21:LCRD)))
                IF (NACH.NE.0) THEN
                  CTMP(NOCH+1:NOCH+NACH)=CRDS(J)(21:20+NACH)
                  NOCH=NOCH+NACH
                END IF
  112         CONTINUE
  113         MXPS=LXPS+IXPS
              MYPS=LYPS+IYPS
              IF (IMAP.NE.100.OR.OORV.NE.1.E12.OR.
     +            ABS(MYPS-ICNY).LT.IHHW+INT(SIZE*PCSZ)) THEN
                CALL PCSETI ('CC (CHARACTER COLOR)',MAX(1,ICLR))
                IF (ICFELL('STITLE',44).NE.0) RETURN
                CALL PLCHHQ (FRCT(MXPS),FRCT(MYPS),CTMP(1:NOCH),
     +                       FPMC*SIZE,0.,REAL(ICNT-1))
                IF (ICFELL('STITLE',45).NE.0) RETURN
              END IF
  114       CONTINUE
C
            CALL SLUBKG (+3)
            IF (ICFELL('STITLE',46).NE.0) RETURN
C
            IF (MTST.NE.0) THEN
              CALL SLOWND
              IF (ICFELL('STITLE',47).NE.0) RETURN
              WRITE (CMSG(1:8),'(F8.2)') TFRA
              CMSG(9:28)=' SECS INTO MOVE TIME'
              CALL SLPWRV (.98,.5,CMSG(1:28),.016)
              IF (ICFELL('STITLE',48).NE.0) RETURN
              TFRA=TFRA+TPER
            END IF
C
            CALL SLFRME
            IF (ICFELL('STITLE',49).NE.0) RETURN
C
  115     CONTINUE
C
        END IF
C
C Stationary frames at end.
C
        IF (TMND.NE.0.) THEN
C
          CALL GFLAS1 (IWWI)
          IF (ICFELL('STITLE',50).NE.0) RETURN
C
          IF (IBGC.NE.0) THEN
            CALL SLBKGD
            IF (ICFELL('STITLE',51).NE.0) RETURN
          END IF
C
          CALL SLUBKG (-4)
          IF (ICFELL('STITLE',52).NE.0) RETURN
C
          DO 118 I=1,NCDS
            READ (CRDS(I)(1:20),'(2I5,I3,I2,F5.1)')
     +                                          IXPS,IYPS,ICLR,ICNT,SIZE
            IF (IXPS.EQ.-9999) GO TO 118
            NOCH=MIN(500,SLSTLN(CRDS(I)(21:LCRD)))
            CTMP=CRDS(I)(21:20+NOCH)
            DO 116 J=I+1,NCDS
              IF (CRDS(J)(1:5).NE.'-9999') GO TO 117
              NACH=MIN(500-NOCH,SLSTLN(CRDS(J)(21:LCRD)))
              IF (NACH.NE.0) THEN
                CTMP(NOCH+1:NOCH+NACH)=CRDS(J)(21:20+NACH)
                NOCH=NOCH+NACH
              END IF
  116       CONTINUE
  117       CALL PCSETI ('CC (CHARACTER COLOR)',MAX(1,ICLR))
            IF (ICFELL('STITLE',53).NE.0) RETURN
            CALL PLCHHQ (FRCT(IXPS-IXND+ICNX),FRCT(IYPS-IYND+ICNY),
     +                   CTMP(1:NOCH),FPMC*SIZE,0.,REAL(ICNT-1))
            IF (ICFELL('STITLE',54).NE.0) RETURN
  118     CONTINUE
C
          CALL SLUBKG (+4)
          IF (ICFELL('STITLE',55).NE.0) RETURN
C
          CALL GFLAS2
          IF (ICFELL('STITLE',56).NE.0) RETURN
C
          NREP=MAX(1,INT(TMND*RNFS+.5))
          IF (MTST.NE.0) NREP=1
C
          DO 119 I=1,NREP
            CALL GFLAS3 (IWWI)
            IF (ICFELL('STITLE',57).NE.0) RETURN
            IF (MTST.NE.0) THEN
              CALL SLOWND
              IF (ICFELL('STITLE',58).NE.0) RETURN
              WRITE (CMSG(1:8),'(F8.2)') TMND
              CMSG(9:20)=' SECS AT END'
              CALL SLPWRV (.98,.5,CMSG(1:20),.016)
              IF (ICFELL('STITLE',59).NE.0) RETURN
            END IF
            CALL SLFRME
            IF (ICFELL('STITLE',60).NE.0) RETURN
  119     CONTINUE
C
        END IF
C
C Fade-out at end.  After the fade-out, colors are restored to maximum
C intensity again.
C
        IF (TFOU.NE.0.) THEN
C
          NREP=MAX(1,INT(TFOU*RNFS+.5))
          IF (MTST.NE.0) NREP=1
C
          IF (IBGF.GE.0.AND.MOD(IBGF,1000).NE.999) THEN
            CALL SLGCLR (MOD(IBGF,1000),BFOR,BFOG,BFOB)
            IF (ICFELL('STITLE',61).NE.0) RETURN
          END IF
C
          IF (IFGF.GE.0.AND.MOD(IFGF,1000).NE.999) THEN
            CALL SLGCLR (MOD(IFGF,1000),FFOR,FFOG,FFOB)
            IF (ICFELL('STITLE',62).NE.0) RETURN
          END IF
C
          DO 124 IREP=NREP,1,-1
C
            DO 120 IOCI=1,NOCI
              CALL SLGCLR (LOCI(IOCI),FRED,FGRN,FBLU)
              IF (ICFELL('STITLE',63).NE.0) RETURN
              IF      ((LOCI(IOCI).EQ.IBGC.AND.IBGF.EQ.-2).OR.
     +                 (LOCI(IOCI).NE.IBGC.AND.IFGF.EQ.-2)) THEN
                CALL RGBHSV (FRED,FGRN,FBLU,H,S,V)
                IF (ICFELL('STITLE',64).NE.0) RETURN
                CALL HSVRGB (H,S,REAL(IREP)*V/REAL(NREP),FRED,FGRN,FBLU)
                IF (ICFELL('STITLE',65).NE.0) RETURN
              ELSE IF (LOCI(IOCI).EQ.IBGC.AND.IBGF.GE.0.AND.
     +                                       MOD(IBGF,1000).NE.999) THEN
                FRED=(REAL(IREP)*FRED+REAL(NREP-IREP)*BFOR)/REAL(NREP)
                FGRN=(REAL(IREP)*FGRN+REAL(NREP-IREP)*BFOG)/REAL(NREP)
                FBLU=(REAL(IREP)*FBLU+REAL(NREP-IREP)*BFOB)/REAL(NREP)
              ELSE IF (LOCI(IOCI).NE.IBGC.AND.IFGF.GE.0.AND.
     +                                       MOD(IFGF,1000).NE.999) THEN
                FRED=(REAL(IREP)*FRED+REAL(NREP-IREP)*FFOR)/REAL(NREP)
                FGRN=(REAL(IREP)*FGRN+REAL(NREP-IREP)*FFOG)/REAL(NREP)
                FBLU=(REAL(IREP)*FBLU+REAL(NREP-IREP)*FFOB)/REAL(NREP)
              END IF
              CALL GSCR (IWRK,LOCI(IOCI),FRED,FGRN,FBLU)
  120       CONTINUE
C
            IF (IBGC.NE.0) THEN
              CALL SLBKGD
              IF (ICFELL('STITLE',66).NE.0) RETURN
            END IF
C
            CALL SLUBKG (-5)
            IF (ICFELL('STITLE',67).NE.0) RETURN
C
            DO 123 I=1,NCDS
              READ (CRDS(I)(1:20),'(2I5,I3,I2,F5.1)')
     +                                          IXPS,IYPS,ICLR,ICNT,SIZE
              IF (IXPS.EQ.-9999) GO TO 123
              NOCH=MIN(500,SLSTLN(CRDS(I)(21:LCRD)))
              CTMP=CRDS(I)(21:20+NOCH)
              DO 121 J=I+1,NCDS
                IF (CRDS(J)(1:5).NE.'-9999') GO TO 122
                NACH=MIN(500-NOCH,SLSTLN(CRDS(J)(21:LCRD)))
                IF (NACH.NE.0) THEN
                  CTMP(NOCH+1:NOCH+NACH)=CRDS(J)(21:20+NACH)
                  NOCH=NOCH+NACH
                END IF
  121         CONTINUE
  122         CALL PCSETI ('CC (CHARACTER COLOR)',MAX(1,ICLR))
              IF (ICFELL('STITLE',68).NE.0) RETURN
              CALL PLCHHQ (FRCT(IXPS-IXND+ICNX),FRCT(IYPS-IYND+ICNY),
     +                     CTMP(1:NOCH),FPMC*SIZE,0.,REAL(ICNT-1))
              IF (ICFELL('STITLE',69).NE.0) RETURN
  123       CONTINUE
C
            CALL SLUBKG (+5)
            IF (ICFELL('STITLE',70).NE.0) RETURN
C
            IF (MTST.NE.0) THEN
              CALL SLOWND
              IF (ICFELL('STITLE',71).NE.0) RETURN
              WRITE (CMSG(1:8),'(F8.2)') TFOU
              CMSG(9:25)=' SECS OF FADE OUT'
              CALL SLPWRV (.98,.5,CMSG(1:25),.016)
              IF (ICFELL('STITLE',72).NE.0) RETURN
            END IF
C
            CALL SLFRME
            IF (ICFELL('STITLE',73).NE.0) RETURN
C
  124     CONTINUE
C
          DO 125 IOCI=1,NOCI
            CALL SLGCLR (LOCI(IOCI),FRED,FGRN,FBLU)
            IF (ICFELL('STITLE',74).NE.0) RETURN
            CALL GSCR (IWRK,LOCI(IOCI),FRED,FGRN,FBLU)
  125     CONTINUE
C
        END IF
C
C If it has been requested, dot the corners of an initial frame (for
C splicing purposes - useless now, I suppose).
C
        IF (IDOT.NE.0) THEN
          CALL GPM (4,XCPF,YCPF)
          IF (MTST.NE.0.OR.IDOT.GT.1) THEN
            CALL WTSTR (.5,.5,'ALIGNMENT FRAME',2,0,0)
            IF (ICFELL('STITLE',75).NE.0) RETURN
          END IF
          CALL SLFRME
          IF (ICFELL('STITLE',76).NE.0) RETURN
        END IF
C
C Close WISS.
C
        CALL GCLWK (IWWI)
C
C Restore the values of internal parameters of PLOTCHAR that have been
C changed.
C
        CALL PCSETI ('CC',ISCC)
        IF (ICFELL('STITLE',77).NE.0) RETURN
C
        IF (IMAP.GT.0) THEN
          CALL PCSETI ('MA',ISMA)
          IF (ICFELL('STITLE',78).NE.0) RETURN
        END IF
C
        IF (OORV.NE.0.) THEN
          CALL PCSETR ('OR',RSOR)
          IF (ICFELL('STITLE',79).NE.0) RETURN
        END IF
C
C Restore original settings of the GKS clipping flag, the normalization
C transformation, and various color indices.
C
        CALL GSCLIP (ISCI)
        CALL GSELNT (ISNT)
        CALL GSPLCI (ISPL)
        CALL GSPMCI (ISPM)
        CALL GSTXCI (ISTX)
C
        RETURN
C
      END
