      SUBROUTINE POLAR(RADIAL,RR,THETA,DATA,MODE,NUM,ISYMNO,SYMSIZ,
     1                  NPBSYM,PLTLAB)
C
C  POLAR PLOT SUBROUTINE FOR DIGLIB
C
C  AUTHOR: JIM LOCKER, SOFTECH INC.
C          MAY 1989
C
C  POLAR ACCEPTS DATA IN THE FOLLOWING MODES;
C
C  MODE(1) CONTROLS THE TYPE OF DATA AND WHETHER OR NOT AXES/RANGE
C  RINGS ARE DRAWN
C
C  MODE(1)= 1 IS R-THETA INFORMATION AND THE PLOT IS TYPE REAL
C
C  MODE(1)= 2 IS REAL-IMAGINARY TYPE INFORMATION AND THE PLOT REPRESENTS
C  A COMPLEX PLANE PLOT
C
C  IF MODE(1)= 1, RR IS AN ARRAY OF RADIAL INFORMATION
C  AND THETA IS AN ARRAY OF ANGULAR INFORMATION CORRESPONDING
C  TO THE RADIAL INFORMATION
C
C  IF MODE(1)= 2, RR IS THE REAL DATA
C  AND THETA IS THE IMAGINARY DATA SO THAT THE DATA SET IS OF THE
C  FORM X+IY
C
C  MODE(1) = 3 IS LIKE MODE(1) = 1 EXCEPT NO AXES OR RANGE RINGS ARE DRAWN
C  MODE(1) = 4 IS LIKE MODE(1) = 2 EXCEPT NO AXES OR RANGE RINGS.
C
C  MODE(2) CONTROLS THE SCALE OF THE PLOT
C
C  MODE(2) = 1 INDICATES A LINEAR RADIAL SCALE
C
C  MODE(2) = 2 INDICATES A LOGARITHMIC RADIAL SCALE
C
C  MODE(3) TELLS THE NUMBER OF RANGE RINGS TO DRAW.  IN LINEAR RADIAL
C  MODE, THIS IS THE NUMBER THAT WILL BE DRAWN.  IN LOGARITHMIC MODE,
C  THIS IS THE NUMBER THAT WILL BE DRAWN PER DECADE.
C
C  MODE(4) DICTATES THE STYLE OF THE LINE FOR RANGE RINGS, FOLLOWING
C  DIGLIB CONVENTION.
C
C  MODE(5) TELLS WHETHER OR NOT RADIAL TICK MARKS ARE TO BE USED.  IF
C  MODE(5) = 0, NO RADIAL TICK MARKS.  IF MODE(5) .GT. 0, THEN OUTWARD
C  POINTING TICKS AT DEGREE INCREMENTS SPECIFIED BY THE VALUE IN MODE(5)
C  IF MODE(5) .LT. 0, THEN INWARD POINTING TICKS.
C
C  MODE(6) SPECIFIES THE COLOR OF THE AXES, RANGE RINGS, AND TICK MARKS
C  MODE(7) SPECIFIES THE COLOR OF THE DATA
C  MODE(8) SPECIFIES THE LINE STYLE OF THE DATA, FOLLOWING DIGLIB 
C  CONVENTION
C
C  NUM IS THE NUMBER OF DATA POINTS
C
C  DATA IS A WORKSPACE PASSED FROM THE CALLING ROUTINE
C
C  ISYMNO IS THE CODE FOR THE SYMBOLS TO DRAW
C
C  SYMSIZ IS THE SIZE OF THE SYMBOLS TO DRAW
C
C  NPBSYM IS THE NUMBER OF DATA POINTS TO SKIP BETWEEN SYMBOLS
C
C  PLTLAB IS THE PLOT LABEL
C
      IMPLICIT NONE
      EXTERNAL LEN
      INTEGER LEN
      REAL GOODCS
      INTEGER*4 NUM,ISYMNO,NPBSYM
      INTEGER*2 MODE(8)
      REAL*4 RADIAL,RADIUS,SYMSIZ,MOD
      REAL*4 RR(NUM),THETA(NUM),DATA(NUM,2)
      INCLUDE DIGLIB$KOM:PLTSIZ.PRM
      INCLUDE DIGLIB$KOM:PLTPRM.PRM
      INCLUDE DIGLIB$KOM:GCLTYP.PRM
      INCLUDE DIGLIB$KOM:GCDCHR.PRM
      INCLUDE DIGLIB$KOM:PLTCLP.PRM
 
      INTEGER I,II,JJ,KK,COLR,IERR,LINSYL,IRAD,IOLDLT,KJK
      CHARACTER*1 LAB(14),TAG(27),PLTLAB(2)
      CHARACTER*13 HEADER
      REAL*4 XORG,YORG,XSKAL,YSKAL
      COMMON/POL/XORG,YORG,XSKAL,YSKAL

      REAL*4 RINC,RAD,CSIZE,ANG,ANGX,ANGY,XX1,YY1,DELTAX,DELTAY
      REAL*4 SPOSX,SPOSY,FPOSX,FPOSY,CPOSX,CPOSY,R,YTOP,YBOT
      REAL*4 XRIGHT,XLEFT,RLENGTH
      EQUIVALENCE (HEADER,TAG)
      DATA HEADER/'MAX RADIUS = '/
C
C  SAVE THE OLD LINE TYPE
C
      IOLDLT = ILNTYP
      ILNTYP = 1
C
C  DETERMINE THE PLOT ORIGIN IN VIRTUAL COORDINATES
C
      RADIUS = RADIAL
      XORG = XVSTRT + (XVLEN-XVSTRT)/2
      YORG = YVSTRT + (YVLEN-YVSTRT)/2
C
C  LOGARITHMIC?
C
      IF(MODE(2) .EQ. 2) RADIUS = ALOG10(RADIUS)
C
C     SET THE PLOT SCALE
C
      XSKAL = (XVLEN - XORG)/RADIUS
      YSKAL = (YVLEN - YORG)/RADIUS
C
C  DEPENDING UPON MODE, DRAW THE AXES AND RANGE RINGS OR NOT.
C
      COLR = MODE(6)
D	WRITE(9,1234)XSKAL,YSKAL,XVLEN,YVLEN,XORG,YORG,RADIUS
D1234	FORMAT(1X,"POLAR:",7F6.2)
      CALL GSCOLR(COLR,IERR)
D	WRITE(9,4321)COLR
D4321	FORMAT(1X,"COLOR IS ",I4)
      IF (MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 2) THEN
        CALL GSMOVE(XVSTRT,YORG)
        CALL GSDRAW(XVLEN,YORG)
        CALL GSMOVE(XORG,YVSTRT)
        CALL GSDRAW(XORG,YVLEN)
        CALL CIRCLE(RADIUS)

C
C  NOW DO RANGE RINGS, IF INDICATED
C
        IF (MODE(3) .GT. 0) THEN
          MOD = FLOAT(MODE(3))
          LINSYL = MODE(4)
D	WRITE(9,3423)LINSYL
D3423	FORMAT("CALLING GSLTYP ",I3)
          CALL GSLTYP(LINSYL)
D	WRITE(9,3424)
D3424	FORMAT("RETURNED FROM GSLTYP")
C
C  TEST FOR LOG OR LIN
C
          IF(MODE(2) .NE. 2) THEN
C
C  LIN
C
            RINC = RADIUS/MOD
            DO 3 II = 1,MODE(3)-1
              RAD = FLOAT(II)*RINC
D	WRITE(9,3425)II,MODE(3),RAD
D3425	FORMAT("CALLING CIRCLE",2(I3,1X),F6.2)
              CALL CIRCLE(RAD)
3           CONTINUE
          ELSE
C
C LOG
C
            RINC = 10/MOD
            JJ = RADIUS
            DO 103 II = 0,JJ+1
              DO 102 KK = 1,MODE(3)
                RAD = ALOG10(FLOAT(KK)*RINC*(10**II))
                IF(RAD .LT. RADIUS) THEN
                  CALL CIRCLE(RAD)
                ENDIF
102           CONTINUE
103         CONTINUE
          ENDIF
        ENDIF
      ENDIF
      CALL GSLTYP(1)
C
C  NOW DETERMINE CHARACTER SIZES FOR LABELS AND TICK MARKS
C
      CSIZE = GOODCS(AMAX1(0.3,AMIN1(YTOP-YBOT,XRIGHT-XLEFT)/80.0))
      CALL GSSETC(CSIZE,0)
C
C  AND DO THE TICK MARKS AND TICK LABELS, IF INDICATED
C
      IF(MODE(5) .NE. 0) THEN
        TICKLN = CSIZE * 0.9
        DO 122 JJ = 0,360,ABS(MODE(5))
          ANG = FLOAT(JJ)*6.283185/360
          ANGX = COS(ANG)
          ANGY = SIN(ANG)
          XX1 = RADIUS*ANGX*XSKAL
          YY1 = RADIUS*ANGY*YSKAL
          DELTAX = TICKLN*ANGX
          DELTAY = TICKLN*ANGY
          SPOSX = XORG + XX1
          SPOSY = YORG + YY1
          IF(MODE(5) .GT. 0) THEN
            FPOSX = SPOSX + DELTAX
            FPOSY = SPOSY + DELTAY
          ELSE
            FPOSX = SPOSX - DELTAX
            FPOSY = SPOSY - DELTAY
          ENDIF
          CALL GSMOVE(SPOSX,SPOSY)
          CALL GSDRAW(FPOSX,FPOSY)
C
C  AND LABEL THE TICKS
C
          CALL LINLAB(JJ,0,LAB,0)
          RLENGTH = LEN(LAB)
D	WRITE(9,4565)RLENGTH
D4565    FORMAT("RLENGTH ",F8.2)
D	WRITE(9,8767)(LAB(KJK),KJK=1,14),JJ
D8767	FORMAT("LAB,jj ",14A1,I4)
          IF(JJ .GT. 90 .AND. JJ .LT.270) THEN
            CPOSX = CSIZE*ANGX*(RLENGTH + 0.75)
D	WRITE(9,9678)CSIZE,ANGX,RLENGTH,CPOSX
D9678	FORMAT(1X,"CSIZE, ANGX, RLENGTH, CPOSX",4(F10.3,1X))
          ELSE
            CPOSX = CSIZE*ANGX*.5
          ENDIF
          IF(JJ .LT. 180) THEN
            CPOSY = .6*ANGY*CSIZE
          ELSE
            CPOSY = ANGY*1.8*CSIZE
          ENDIF
          IF(JJ .GE. 355) CYCLE
          IF(MODE(5) .GT. 0) THEN
D	    WRITE(9,4123)FPOSX,CPOSX,FPOSY,CPOSY
D4123	    FORMAT("FPOSX, CPOSX, FPOSY, CPOSY",4(F10.3,1X))
            CALL GSMOVE(FPOSX+CPOSX,FPOSY+CPOSY)
          ELSE
D	    WRITE(9,4123)SPOSX,CPOSX,SPOSY,CPOSY
D4124	    FORMAT("SPOSX, CPOSX, SPOSY, CPOSY",4(F10.3,1X))
            CALL GSMOVE(SPOSX+ 1.1*CPOSX,SPOSY+ 1.5*CPOSY)
          ENDIF
          CALL GSPSTR(LAB)
122     CONTINUE
      ENDIF
C
C  NOW PROVIDE THE MAXIMUM RADIUS VALUE AS A LABEL
C
      IF(MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 2) THEN
        IRAD = RADIAL
        CALL LINLAB(IRAD,0,LAB,0)
        CALL GSMOVE(XORG + RADIUS*XSKAL*0.8,YORG+RADIUS*YSKAL)
        DO 123 JJ = 1,14
123     TAG(JJ+13) = LAB(JJ)
        CALL GSPSTR(TAG)
      ENDIF
C
C  AND PLACE THE PLOT LABEL ON THE PLOT
C
      RLENGTH = LEN(PLTLAB)
      CALL GSMOVE(XORG-CSIZE*RLENGTH/2,YORG - RADIUS*YSKAL - 5*CSIZE)
      CALL GSPSTR(PLTLAB)
C
C DEPENDING UPON MODE, CONVERT POLAR DATA TO X-Y FOR PLOT, OR NOT
C
      IF(MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 3) THEN
        DO 150, JJ = 1,NUM
C
C  LOG OR LIN RADIUS
C
          IF(MODE(2) .NE. 2) THEN
            R = RR(JJ)
          ELSE
            R = ALOG10(RR(JJ))
          ENDIF
          DATA(JJ,1)=R * COS(THETA(JJ))
          DATA(JJ,2)=R * SIN(THETA(JJ))
150     CONTINUE
      ELSE
        DO 155 JJ = 1,NUM
          DATA(JJ,1)=RR(JJ)
          DATA(JJ,2)=THETA(JJ)
155     CONTINUE
      ENDIF
C
C  LOGARITHMIC AND OF FORM X+IY ?
C
      IF(MODE(2) .EQ. 2 .AND. (MODE(1) .EQ. 2 .OR. MODE(1) .EQ. 4)) THEN
        DO 165 II = 1,NUM
          DO 165 KK = 1,2
            IF(DATA(II,KK) .GT. 0)DATA(II,KK) = ALOG10(DATA(II,KK))
C
C  DON'T PLOT ANYTHING THAT IS A NEGATIVE VALUE ON A LOG POLAR PLOT
C
            IF(DATA(II,KK) .LT. 0)DATA(II,KK) = 0
165     CONTINUE
      ENDIF
C
C  NOW SCALE THE DATA TO FIT THE PLOT
C
      DO 170 JJ = 1,NUM
        DATA(JJ,1) = DATA(JJ,1)*XSKAL + XORG
        DATA(JJ,2) = DATA(JJ,2)*YSKAL + YORG
170   CONTINUE
      LINSYL = MODE(8)
      CALL GSLTYP(LINSYL)
      CALL GSMOVE(DATA(1,1),DATA(1,2))
      COLR = MODE(7)
      CALL GSCOLR(COLR,IERR)
      DO 211 JJ = 2,NUM
        CALL GSDRAW(DATA(JJ,1),DATA(JJ,2))
211   CONTINUE
      CALL GSLTYP(1)
C
C       NOW ADD SYMBOLS IF DESIRED
C
      IF (ISYMNO .LE. 0) GO TO 800
C
C   DO SYMBOLS IN SOLID LINES
C
      DO 400 I=1,NUM,NPBSYM
      CALL GSMOVE(DATA(I,1),DATA(I,2))
      CALL SYMBOL(ISYMNO,SYMSIZ)
400   CONTINUE
C
C   RESTORE LINE TYPE
C

      ILNTYP = IOLDLT
800   CONTINUE
      RETURN
      END
C
C  THIS SUBROUTINE DRAWS THE CIRCLES FOR THE RANGE RINGS
C
      SUBROUTINE CIRCLE(RADIUS)
      IMPLICIT NONE
      REAL*4 RADIUS

      INCLUDE DIGLIB$KOM:PLTSIZ.PRM
      INCLUDE DIGLIB$KOM:PLTPRM.PRM
      INCLUDE DIGLIB$KOM:GCLTYP.PRM
      INCLUDE DIGLIB$KOM:GCDCHR.PRM
      INCLUDE DIGLIB$KOM:PLTCLP.PRM

      INTEGER*2 II
      REAL*4 XORG,YORG,XSKAL,YSKAL,DTORAD,XX,X,Y
      COMMON/POL/XORG,YORG,XSKAL,YSKAL

      DTORAD = 6.283185/360
      CALL GSMOVE(XORG+XSKAL*RADIUS,YORG)
      DO 10 II = 1,360,2
      XX = FLOAT(II)
      X = XORG+RADIUS*XSKAL*COS(DTORAD*XX)
      Y = YORG+RADIUS*YSKAL*SIN(DTORAD*XX)
D	WRITE(9,876)X,Y
D876	FORMAT("CIRCLE ",2F8.3)
      CALL GSDRAW(X,Y)
10    CONTINUE
      RETURN
      END
