PLOTC Subroutine

public subroutine PLOTC(Y, X, Char, N)

NAME

plotc(3f) - [M_datapac:GENERIC_LINE_PLOT] generate a line printer
plot with special plot characters

SYNOPSIS

   SUBROUTINE PLOTC(Y,X,Char,N)

DESCRIPTION

plotc(3f) yields a one-page printer plot of y(i) versus x(i) with
special plotting characters.

this 'special plotting character' capability allows the data analyst
to incorporate information from a third variable (aside from y and x)
into the plot.

the plot character used at the i-th plotting position (that is,
at the coordinate (x(i),y(i))) will be

  1 if char(i) is between  0.5 and  1.5
  2 if char(i) is between  1.5 and  2.5
    .
    .
    .
  9 if char(i) is between  8.5 and  9.5
  0 if char(i) is between  9.5 and 10.5
  a if char(i) is between 10.5 and 11.5
  b if char(i) is between 11.5 and 12.5
  c if char(i) is between 12.5 and 13.5
    .
    .
    .
  w if char(i) is between 32.5 and 33.5
  x if char(i) is between 33.5 and 34.5
  y if char(i) is between 34.5 and 35.5
  z if char(i) is between 35.5 and 36.5
  x if char(i) is any value outside the range
                           0.5 to  36.5.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_plotc
use M_datapac, only : plotc
implicit none
! call plotc(x,y)
end program demo_plotc

Results:

AUTHOR

The original DATAPAC library was written by James Filliben of the Statistical
Engineering Division, National Institute of Standards and Technology.

MAINTAINER

John Urban, 2022.05.31

LICENSE

CC0-1.0

REFERENCES

  • FILLIBEN, ‘STATISTICAL ANALYSIS OF INTERLAB FATIGUE TIME DATA’, UNPUBLISHED MANUSCRIPT (AVAILABLE FROM AUTHOR) PRESENTED AT THE ‘COMPUTER-ASSISTED DATA ANALYSIS’ SESSION AT THE NATIONAL MEETING OF THE AMERICAN STATISTICAL ASSOCIATION, NEW YORK CITY, DECEMBER 27-30, 1973.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), dimension(:) :: Y
real(kind=wp), dimension(:) :: X
real(kind=wp), dimension(:) :: Char
integer :: N

Common Blocks

HIST (subroutine)
PLOT10 (subroutine)
PLOT6 (subroutine)
PLOT7 (subroutine)
PLOT8 (subroutine)
PLOT9 (subroutine)
PLOTCO (subroutine)
PLOT (subroutine)
PLOTSC (subroutine)
PLOTS (subroutine)
PLOTSP (subroutine)
PLOTU (subroutine)
PLOTX (subroutine)
PLOTXX (subroutine)
HIST (subroutine)
PLOT10 (subroutine)
PLOT6 (subroutine)
PLOT7 (subroutine)
PLOT8 (subroutine)
PLOT9 (subroutine)
PLOTC (subroutine)
PLOTCO (subroutine)
PLOT (subroutine)
PLOTSC (subroutine)
PLOTS (subroutine)
PLOTSP (subroutine)
PLOTU (subroutine)
PLOTX (subroutine)
PLOTXX (subroutine)
"> common /BLOCK1/

Type Attributes Name Initial
integer :: IGRaph(55,130)

Source Code

SUBROUTINE PLOTC(Y,X,Char,N)
REAL(kind=wp) :: aim1, Char, cutoff, hold, ratiox, ratioy, X, x25,  x75, xmax, xmid, xmin, Y, ylable, ymax, ymin
INTEGER       :: i, iarg, iflag, ip2, j, k, mx, my, N, n2
!
!     INPUT ARGUMENTS--Y      = THE  VECTOR OF
!                               (UNSORTED OR SORTED) OBSERVATIONS
!                               TO BE PLOTTED VERTICALLY.
!                    --X      = THE  VECTOR OF
!                               (UNSORTED OR SORTED) OBSERVATIONS
!                               TO BE PLOTTED HORIZONTALLY.
!                    --CHAR   = THE  VECTOR OF
!                               OBSERVATIONS WHICH CONTROL THE
!                               VALUE OF EACH INDIVIDUAL PLOT
!                               CHARACTER.
!                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
!                               IN THE VECTOR Y.
!     OUTPUT--A ONE-page PRINTER PLOT OF Y(I) VERSUS X(I)
!             WITH SPECIAL PLOT CHARACTERS.
!     PRINTING--YES.
!     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
!                   OF N FOR THIS SUBROUTINE.
!     MODE OF INTERNAL OPERATIONS--.
!     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y),
!              THE HORIZONTAL AXIS VECTOR (X),
!              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
!              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
!              PLOTTED.
!              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
!              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
!              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
!              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
!              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
!              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
!              PLOTTED).
!              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
!              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
!              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
!              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
!              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
!              SUBROUTINE.
!     ORIGINAL VERSION--OCTOBER   1974.
!     UPDATED         --NOVEMBER  1974.
!     UPDATED         --JANUARY   1975.
!     UPDATED         --JULY      1975.
!     UPDATED         --SEPTEMBER 1975.
!     UPDATED         --OCTOBER   1975.
!     UPDATED         --NOVEMBER  1975.
!     UPDATED         --FEBRUARY  1976.
!     UPDATED         --FEBRUARY  1977.
!
!---------------------------------------------------------------------
!
CHARACTER(len=4) :: IGRaph
CHARACTER(len=4) :: iplotc
CHARACTER(len=4) :: sbnam1 , sbnam2
CHARACTER(len=4) :: alph11 , alph12 , alph21 , alph22 , alph31 , alph32
CHARACTER(len=4) :: alph41 , alph42
CHARACTER(len=4) :: blank , hyphen , alphai , alphax
CHARACTER(len=4) :: alpham , alphaa , alphad , alphan , equal
!
      DIMENSION Y(:)
      DIMENSION X(:)
      DIMENSION Char(:)
      DIMENSION ylable(11)
      DIMENSION iplotc(37)
      COMMON /BLOCK1/ IGRaph(55,130)
!
      DATA sbnam1 , sbnam2/'PLOT' , 'C   '/
      DATA alph11 , alph12/'FIRS' , 'T   '/
      DATA alph21 , alph22/'SECO' , 'ND  '/
      DATA alph31 , alph32/'THIR' , 'D   '/
      DATA alph41 , alph42/'FOUR' , 'TH  '/
      DATA blank , hyphen , alphai , alphax/' ' , '-' , 'I' , 'X'/
      DATA alpham , alphaa , alphad , alphan , equal/'M' , 'A' , 'D' ,  &
     &     'N' , '='/
      DATA iplotc(1) , iplotc(2) , iplotc(3) , iplotc(4) , iplotc(5) ,  &
     &     iplotc(6) , iplotc(7) , iplotc(8) , iplotc(9) , iplotc(10) , &
     &     iplotc(11) , iplotc(12) , iplotc(13) , iplotc(14) ,          &
     &     iplotc(15) , iplotc(16) , iplotc(17) , iplotc(18) ,          &
     &     iplotc(19) , iplotc(20) , iplotc(21) , iplotc(22) ,          &
     &     iplotc(23) , iplotc(24) , iplotc(25) , iplotc(26) ,          &
     &     iplotc(27) , iplotc(28) , iplotc(29) , iplotc(30) ,          &
     &     iplotc(31) , iplotc(32) , iplotc(33) , iplotc(34) ,          &
     &     iplotc(35) , iplotc(36) , iplotc(37)/'1' , '2' , '3' , '4' , &
     &     '5' , '6' , '7' , '8' , '9' , '0' , 'A' , 'B' , 'C' , 'D' ,  &
     &     'E' , 'F' , 'G' , 'H' , 'I' , 'J' , 'K' , 'L' , 'M' , 'N' ,  &
     &     'O' , 'P' , 'Q' , 'R' , 'S' , 'T' , 'U' , 'V' , 'W' , 'X' ,  &
     &     'Y' , 'Z' , 'X'/
!
      cutoff = (10.0_wp**10) - 1000.0_wp
!
!     CHECK THE INPUT ARGUMENTS FOR ERRORS
!
      WRITE (G_IO,99001)
99001 FORMAT ('1')
      IF ( N<1 ) THEN
         WRITE (G_IO,99012)
         WRITE (G_IO,99013)
         WRITE (G_IO,99014) alph41 , alph42 , sbnam1 , sbnam2
         WRITE (G_IO,99002) N
99002    FORMAT (' ','IS NON-NEGATIVE (WITH VALUE = ',I0,')')
         WRITE (G_IO,99012)
         RETURN
      ELSE
         IF ( N==1 ) THEN
            WRITE (G_IO,99012)
            WRITE (G_IO,99013)
            WRITE (G_IO,99014) alph41 , alph42 , sbnam1 , sbnam2
            WRITE (G_IO,99003) N
99003       FORMAT (' ','HAS THE VALUE 1')
            WRITE (G_IO,99012)
            RETURN
         ELSE
!
            hold = Y(1)
            DO i = 2 , N
               IF ( Y(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99012)
            WRITE (G_IO,99013)
            WRITE (G_IO,99014) alph11 , alph12 , sbnam1 , sbnam2
            WRITE (G_IO,99015) hold
            WRITE (G_IO,99012)
            RETURN
         ENDIF
 50      hold = X(1)
         DO i = 2 , N
            IF ( X(i)/=hold ) GOTO 100
         ENDDO
         WRITE (G_IO,99012)
         WRITE (G_IO,99013)
         WRITE (G_IO,99014) alph21 , alph22 , sbnam1 , sbnam2
         WRITE (G_IO,99015) hold
         WRITE (G_IO,99012)
         RETURN
      ENDIF
 100  hold = Char(1)
      DO i = 2 , N
         IF ( Char(i)/=hold ) GOTO 200
      ENDDO
      WRITE (G_IO,99012)
      WRITE (G_IO,99004)
99004 FORMAT (' ','               NON-FATAL DIAGNOSTIC               ')
      WRITE (G_IO,99014) alph31 , alph32 , sbnam1 , sbnam2
      WRITE (G_IO,99015) hold
      WRITE (G_IO,99012)
!
 200  DO i = 1 , N
         IF ( Y(i)<cutoff ) GOTO 300
      ENDDO
      WRITE (G_IO,99012)
      WRITE (G_IO,99013)
      WRITE (G_IO,99014) alph11 , alph12 , sbnam1 , sbnam2
      WRITE (G_IO,99016)
      WRITE (G_IO,99017) cutoff
      WRITE (G_IO,99012)
      RETURN
 300  DO i = 1 , N
         IF ( X(i)<cutoff ) GOTO 400
      ENDDO
      WRITE (G_IO,99012)
      WRITE (G_IO,99013)
      WRITE (G_IO,99014) alph21 , alph22 , sbnam1 , sbnam2
      WRITE (G_IO,99016)
      WRITE (G_IO,99017) cutoff
      WRITE (G_IO,99012)
      RETURN
 400  DO i = 1 , N
         IF ( Char(i)<cutoff ) GOTO 500
      ENDDO
      WRITE (G_IO,99012)
      WRITE (G_IO,99013)
      WRITE (G_IO,99014) alph31 , alph32 , sbnam1 , sbnam2
      WRITE (G_IO,99016)
      WRITE (G_IO,99017) cutoff
      WRITE (G_IO,99012)
      RETURN
!
 500  n2 = 0
      DO i = 1 , N
         IF ( Y(i)<cutoff .AND. X(i)<cutoff .AND. Char(i)<cutoff ) THEN
            n2 = n2 + 1
            IF ( n2>=2 ) GOTO 600
         ENDIF
      ENDDO
      WRITE (G_IO,99012)
      WRITE (G_IO,99013)
      WRITE (G_IO,99005) alph11 , alph12 , alph21 , alph22 , alph31 ,    &
     &                  alph32
99005 FORMAT (' ','THE ',A4,A4,', ',A4,A4,', AND ',A4,A4)
      WRITE (G_IO,99006) sbnam1 , sbnam2
99006 FORMAT (' ','INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
      WRITE (G_IO,99007)
99007 FORMAT (' ','ARE SUCH THAT TOO MANY POINTS HAVE BEEN',            &
     &        ' EXCLUDED FROM THE PLOT.')
      WRITE (G_IO,99008) n2
99008 FORMAT (' ','ONLY ',I0,' POINTS ARE LEFT TO BE PLOTTED.')
      WRITE (G_IO,99012)
      RETURN
!
!-----START POINT-----------------------------------------------------
!
!     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
!
 600  DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  ymin = Y(i)
                  ymax = Y(i)
                  EXIT
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  IF ( Y(i)<ymin ) ymin = Y(i)
                  IF ( Y(i)>ymax ) ymax = Y(i)
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , 9
         aim1 = i - 1
         ylable(i) = ymax - (aim1/8.0_wp)*(ymax-ymin)
      ENDDO
!
!     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS
!     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND
!     X75 (=THE 75% POINT)
!
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  xmin = X(i)
                  xmax = X(i)
                  EXIT
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  IF ( X(i)<xmin ) xmin = X(i)
                  IF ( X(i)>xmax ) xmax = X(i)
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      xmid = (xmin+xmax)/2.0_wp
      x25 = 0.75_wp*xmin + 0.25_wp*xmax
      x75 = 0.25_wp*xmin + 0.75_wp*xmax
!
!     BLANK OUT THE GRAPH
!
      DO i = 1 , 45
         DO j = 1 , 109
            IGRaph(i,j) = blank
         ENDDO
      ENDDO
!
!     PRODUCE THE VERTICAL AXES
!
      DO i = 3 , 43
         IGRaph(i,5) = alphai
         IGRaph(i,109) = alphai
      ENDDO
      DO i = 3 , 43 , 5
         IGRaph(i,5) = hyphen
         IGRaph(i,109) = hyphen
      ENDDO
      IGRaph(3,1) = equal
      IGRaph(3,2) = alpham
      IGRaph(3,3) = alphaa
      IGRaph(3,4) = alphax
      IGRaph(23,1) = equal
      IGRaph(23,2) = alpham
      IGRaph(23,3) = alphai
      IGRaph(23,4) = alphad
      IGRaph(43,1) = equal
      IGRaph(43,2) = alpham
      IGRaph(43,3) = alphai
      IGRaph(43,4) = alphan
!
!     PRODUCE THE HORIZONTAL AXES
!
      DO j = 7 , 107
         IGRaph(1,j) = hyphen
         IGRaph(45,j) = hyphen
      ENDDO
      DO j = 7 , 107 , 25
         IGRaph(1,j) = alphai
         IGRaph(45,j) = alphai
      ENDDO
      DO j = 20 , 107 , 25
         IGRaph(1,j) = alphai
         IGRaph(45,j) = alphai
      ENDDO
!
!     DETERMINE THE (X,Y) PLOT POSITIONS
!
      ratioy = 40.0_wp/(ymax-ymin)
      ratiox = 100.0_wp/(xmax-xmin)
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  mx = ratiox*(X(i)-xmin) + 0.5_wp
                  mx = mx + 7
                  my = ratioy*(Y(i)-ymin) + 0.5_wp
                  my = 43 - my
                  iarg = 37
                  IF ( 0.5_wp<Char(i) .AND. Char(i)<36.5_wp ) iarg = Char(i)  &
     &                 + 0.5_wp
                  IGRaph(my,mx) = iplotc(iarg)
               ENDIF
            ENDIF
         ENDIF
      ENDDO
!
!     WRITE OUT THE GRAPH
!
      DO i = 1 , 45
         ip2 = i + 2
         iflag = ip2 - (ip2/5)*5
         k = ip2/5
         IF ( iflag/=0 ) WRITE (G_IO,99009) (IGRaph(i,j),j=1,109)
!
99009    FORMAT (' ',20X,109A1)
         IF ( iflag==0 ) WRITE (G_IO,99010) ylable(k) ,                  &
     &                          (IGRaph(i,j),j=1,109)
99010    FORMAT (' ',F20.7,109A1)
      ENDDO
      WRITE (G_IO,99011) xmin , x25 , xmid , x75 , xmax
99011 FORMAT (' ',14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
!
99012 FORMAT (' ','**************************************************', &
     &        '********************')
99013 FORMAT (' ','                   FATAL ERROR                    ')
99014 FORMAT (' ','THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,         &
     &        ' SUBROUTINE')
99015 FORMAT (' ','HAS ALL ELEMENTS = ',E15.8)
99016 FORMAT (' ','HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
99017 FORMAT (' ','VALUE OF ',E15.8)
!
END SUBROUTINE PLOTC