SUBROUTINE PALLET
!******************************************************************************
!*                                                                            *
!*  THIS SUBROUTINE CREATES A PALLET BASED ON USER INPUTS                     *
!*                                                                            *
!******************************************************************************
  USE PALET
  USE DFLIB, SETPIXEL0=>SETPIXEL

  IMPLICIT NONE

  INTEGER(KIND=2)I

  INTEGER(KIND=4)IAAA, IPALPST, ITMP, RGB, II

  LOGICAL  STATUSMODE
  REAL(KIND=4) RTHETA, BTHETA, GTHETA, REDMAX, REDMIN, GREENMAX, GREENMIN, BLUEMAX, BLUEMIN,  &
               TEMPR, TEMPB, TEMPG, TEMPR1, TEMPB1, TEMPG1, TEMPR2, TEMPB2, TEMPG2, TEMPR3,   &
			   TEMPB3, TEMPG3, TEMPR4, TEMPB4, TEMPG4, TEMPR5, TEMPB5, TEMPG5, TEMPR6, TEMPB6,&
			   TEMPG6, TEMPR7, TEMPB7, TEMPG7 
  TYPE(WINDOWCONFIG)WC

!*
!*     Make sure all palette numbers are valid.
!*
  DO I = 1, 256
    PAL(I) = 0
    IRED(I) = 0
    IBLUE(I) = 0
    IGREEN(I) = 0
  END DO

!*
!*     Get configuration variables for current mode.

!*
  STATUSMODE = GETWINDOWCONFIG(WC)
!*
!*     Loop through each graphics mode that supports palettes.
!*

  IF( WC.NUMCOLORS .EQ. 0 ) THEN
    STOP 'Graphics mode does not support color'
  ELSE
!* INITIALIZE STUFF
    I = 1
    RTHETA = REDSTART
    BTHETA = BLUESTART
    GTHETA = GREENSTART
	REDMAX = 0.00
	REDMIN = 1.00
	BLUEMAX = 0.00
	BLUEMIN = 1.00
	GREENMAX = 0.00
	GREENMIN = 1.00
    IRED(I) = 0
    IBLUE(I) = 0
    IGREEN(I) = 0
    IAAA = 1
    IPALPST = -100

!* CLEAR SCREEN
    CALL CLEARSCREEN($GCLEARSCREEN)
!* CALCULATE STEP SIZES
	RDELTHE = (REDEND - REDSTART)/REAL(WC%NUMCOLORS)
	GDELTHE = (GREENEND - GREENSTART)/REAL(WC%NUMCOLORS)
	BDELTHE = (BLUEEND - BLUESTART)/REAL(WC%NUMCOLORS)
!* IF COLOR NORMILIZATION HAS BEEN SELECTED, RUN THROUGH COSINE EQUATIONS TO GET MIN AND MAX VALUES.  IF
!* NOT SET MIN TO 0 AND MAX TO 1
	DO II = 1, WC%NUMCOLORS
	  IF(LNRED)THEN
        TEMPR = ABS(COS(RTHETA+RPHS))
	    RTHETA = RTHETA + RDELTHE
	    IF(TEMPR > REDMAX)THEN
	      REDMAX = TEMPR
	    ENDIF
	    IF(TEMPR < REDMIN)THEN
	      REDMIN = TEMPR
	    ENDIF
	  ELSE
	    REDMAX = 1.00E+00
		REDMIN = 0.00E+00
	  ENDIF
	  IF(LNGREEN)THEN
  	    TEMPG = ABS(COS(GTHETA+GPHS))
	    GTHETA = GTHETA + GDELTHE
	    IF(TEMPG > GREENMAX)THEN
	      GREENMAX = TEMPG
	    ENDIF
	    IF(TEMPG < GREENMIN)THEN
	      GREENMIN = TEMPG
	    ENDIF
	  ELSE
	    GREENMAX = 1.00E+00
		GREENMIN = 0.00E+00
	  ENDIF
	  IF(LNBLUE)THEN
	    TEMPB = ABS(COS(BTHETA+BPHS))
	    BTHETA = BTHETA + BDELTHE
	    IF(TEMPB > BLUEMAX)THEN
	      BLUEMAX = TEMPB
	    ENDIF
	    IF(TEMPB < BLUEMIN)THEN
	      BLUEMIN = TEMPB
	    ENDIF
	  ELSE
	    BLUEMAX = 1.00E+00
		BLUEMIN = 0.00E+00
	  ENDIF
	ENDDO
!* SET STARTING ANGLE
    RTHETA = REDSTART
    BTHETA = BLUESTART
    GTHETA = GREENSTART
    DO WHILE (IAAA <= WC%NUMCOLORS)
!* START GENERATING COLOR COMPONENT VALUES.  WAIT FOR DELAY, THEN INCREMENT, EQUATION SPLIT FOR DEBUGGING
      IF(IAAA.GT.IRDELAY)THEN
	    TEMPR1 = RTHETA+RPHS
		TEMPR2 = COS(TEMPR1)
		TEMPR3 = ABS(TEMPR2)
		TEMPR4 = ABS(TEMPR3 - REDMIN)
		TEMPR5 = REDMAX - REDMIN
		TEMPR6 = TEMPR4/TEMPR5
		TEMPR7 = TEMPR6*RMAX
		IRED(I) = MIN(INT(TEMPR7),255)
        RTHETA=RTHETA+RDELTHE
      ENDIF
      IF(IAAA.GE.IBDELAY)THEN
	    TEMPB1 = BTHETA+BPHS
		TEMPB2 = COS(TEMPB1)
		TEMPB3 = ABS(TEMPB2)
		TEMPB4 = ABS(TEMPB3 - BLUEMIN)
		TEMPB5 = BLUEMAX - BLUEMIN
		TEMPB6 = TEMPB4/TEMPB5
		TEMPB7 = TEMPB6*BMAX
		IBLUE(I) = MIN(INT(TEMPB7),255)
        BTHETA=BTHETA+BDELTHE
      ENDIF
      IF(IAAA.GE.IGDELAY)THEN
	    TEMPG1 = GTHETA+GPHS
		TEMPG2 = COS(TEMPG1)
		TEMPG3 = ABS(TEMPG2)
		TEMPG4 = ABS(TEMPG3 - GREENMIN)
		TEMPG5 = GREENMAX - GREENMIN
		TEMPG6 = TEMPG4/TEMPG5
		TEMPG7 = TEMPG6*GMAX
		IGREEN(I) = MIN(INT(TEMPG7),255)
        GTHETA=GTHETA+GDELTHE
      ENDIF
!* COMBINE COLORS TO FORM COMPOSIT
      ITMP = RGB(IRED(I), IGREEN(I), IBLUE(I))
!* CHECK TO SEE IF CURRENT COLOR IS THE SAME AS THE PREVIOUS COLOR.  IF IT IS THEN CALCULATE A NEW COLOR
!* IF DIFFERENT, THEN SAVE AND CONTINUE
      IF(IPALPST /= ITMP)THEN
        PAL(I) = ITMP
        I = I + 1
        IAAA = IAAA+1
        IPALPST = PAL(I-1)
      ENDIF
    END DO
!* SET FIRST COLOR TO BLACK
    PAL(1)=0
	IRED(1) = 0
	IGREEN(1) = 0
	IBLUE(1) = 0

!* CREATE NEW PALETTE
    CALL CREATE_PALLET
  END IF

  RETURN
END
