PLOTCT Subroutine

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

NAME

plotct(3f) - [M_datapac:GENERIC_LINE_PLOT] generate a line printer
plot for the terminal (71 characters wide)

SYNOPSIS

   SUBROUTINE PLOTCT(Y,X,Char,N)

DESCRIPTION

plotct(3f) yields a narrow-width (71-character) plot of y(i) versus
x(i) with special plotting characters.

its narrow width makes it appropriate for use on a terminal.

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_plotct
use M_datapac, only : plotct
implicit none
! call plotct(x,y)
end program demo_plotct

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

Source Code

      SUBROUTINE PLOTCT(Y,X,Char,N)
REAL(kind=wp) :: aim1 , airow , anumcm , anumlm , anumr , anumrm , Char ,     &
     &     cutoff , delx , dely , hold , X , xlable , xmax , xmin ,     &
     &     xwidth , Y , ylable , ylower , ymax
REAL(kind=wp) :: ymin , yupper , ywidth
INTEGER :: i , ia , icol , icolmx , irow , ixdel , N , n2 ,    &
     &        numcol , numlab , numr25 , numr50 , numr75 , numrow
!
!     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 NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
!             OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS.
!             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
!             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
!     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.
!            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
!              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
!              VERY SMALL.
!              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
!              EMPLOYED FOR THE PLOT.
!     ORIGINAL VERSION--FEBRUARY  1974.
!     UPDATED         --APRIL     1974.
!     UPDATED         --OCTOBER   1974.
!     UPDATED         --OCTOBER   1975.
!     UPDATED         --NOVEMBER  1975.
!     UPDATED         --FEBRUARY  1977.
!
!---------------------------------------------------------------------
!
CHARACTER(len=4) :: iline
CHARACTER(len=4) :: iplotc
CHARACTER(len=4) :: jplotc
CHARACTER(len=4) :: iaxisc
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
!
      DIMENSION Y(:)
      DIMENSION X(:)
      DIMENSION Char(:)
      DIMENSION iline(72) , xlable(10)
      DIMENSION iplotc(37)
!
      DATA sbnam1 , sbnam2/'PLOT' , 'CT  '/
      DATA alph11 , alph12/'FIRS' , 'T   '/
      DATA alph21 , alph22/'SECO' , 'ND  '/
      DATA alph31 , alph32/'THIR' , 'D   '/
      DATA alph41 , alph42/'FOUR' , 'TH  '/
      DATA blank , hyphen , alphai/' ' , '-' , 'I'/
      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
!
      IF ( N<1 ) THEN
         WRITE (G_IO,99012)
         WRITE (G_IO,99013)
         WRITE (G_IO,99014) alph41 , alph42 , sbnam1 , sbnam2
         WRITE (G_IO,99001) N
99001    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,99002) N
99002       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,99003)
99003 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,99004) alph11 , alph12 , alph21 , alph22 , alph31 ,    &
     &                  alph32
99004 FORMAT (' ','THE ',A4,A4,', ',A4,A4,', AND ',A4,A4)
      WRITE (G_IO,99005) sbnam1 , sbnam2
99005 FORMAT (' ','INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
      WRITE (G_IO,99006)
99006 FORMAT (' ','ARE SUCH THAT TOO MANY POINTS HAVE BEEN',            &
     &        ' EXCLUDED FROM THE PLOT.')
      WRITE (G_IO,99007) n2
99007 FORMAT (' ','ONLY ',I0,' POINTS ARE LEFT TO BE PLOTTED.')
      WRITE (G_IO,99012)
      RETURN
!
!-----START POINT-----------------------------------------------------
!
!     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS
!     BEEN SET TO 25 ROWS AND 49 COLUMNS.
!
 600  numrow = 25
      numcol = 49
      anumr = numrow
      anumrm = numrow - 1
      anumcm = numcol - 1
      numr25 = (numrow/4) + 1
      numr50 = (numrow/2) + 1
      numr75 = 3*(numrow/4) + 1
      ixdel = (numcol-1)/4
      numlab = 5
      anumlm = numlab - 1
!
!     SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT,
!     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
!     FOR A MARGIN WITHIN THE PLOT.
!
      WRITE (G_IO,99008)
99008 FORMAT (' ')
      WRITE (G_IO,99009)
!
99009 FORMAT (' ','THE FOLLOWING IS A PLOT OF Y(I) VERSUS X(I)')
      DO icol = 1 , numcol
         iline(icol) = hyphen
      ENDDO
      DO icol = 1 , numcol , ixdel
         iline(icol) = alphai
      ENDDO
      WRITE (G_IO,99018) (iline(i),i=1,numcol)
      WRITE (G_IO,99019) blank
!
!     DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X.
!
      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)
                  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 ( Y(i)<ymin ) ymin = Y(i)
                  IF ( Y(i)>ymax ) ymax = Y(i)
                  IF ( X(i)<xmin ) xmin = X(i)
                  IF ( X(i)>xmax ) xmax = X(i)
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      dely = ymax - ymin
      delx = xmax - xmin
      ywidth = dely/anumrm
      xwidth = delx/anumcm
!
!     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
!     ALSO DETERMINE THE APPROPRIATE PLOT CHARACTERS.
!
      DO irow = 1 , numrow
         DO icol = 1 , numcol
            iline(icol) = blank
         ENDDO
         airow = irow
         yupper = ymax + (1.5_wp-airow)*ywidth
         ylable = ymax + (1.0_wp-airow)*ywidth
         ylower = ymax + (0.5_wp-airow)*ywidth
         IF ( irow==numrow ) ylable = ymin
         DO i = 1 , N
            IF ( Y(i)<cutoff ) THEN
               IF ( X(i)<cutoff ) THEN
                  IF ( Char(i)<cutoff ) THEN
                     IF ( ylower<=Y(i) .AND. Y(i)<yupper ) THEN
                        icol = ((X(i)-xmin)/xwidth) + 1.5_wp
                        ia = Char(i) + 0.5_wp
                        IF ( 1<=ia .AND. ia<=36 ) THEN
                           jplotc = iplotc(ia)
                        ELSE
                           jplotc = iplotc(37)
                        ENDIF
                        iline(icol) = jplotc
                     ENDIF
                  ENDIF
               ENDIF
            ENDIF
         ENDDO
         icolmx = 1
         DO icol = 1 , numcol
            IF ( iline(icol)/=blank ) icolmx = icol
         ENDDO
         iaxisc = alphai
         IF ( irow==1 .OR. irow==numrow ) iaxisc = hyphen
         IF ( irow==numr25 .OR. irow==numr50 .OR. irow==numr75 )        &
     &        iaxisc = hyphen
         WRITE (G_IO,99010) ylable , iaxisc , (iline(icol),icol=1,icolmx)
99010    FORMAT (' ',E14.7,1X,A1,2X,50A1)
      ENDDO
!
!     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
!     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABELS.
!
      WRITE (G_IO,99019) blank
      DO icol = 1 , numcol
         iline(icol) = hyphen
      ENDDO
      DO icol = 1 , numcol , ixdel
         iline(icol) = alphai
      ENDDO
      WRITE (G_IO,99018) (iline(icol),icol=1,numcol)
      DO i = 1 , numlab
         aim1 = i - 1
         xlable(i) = xmin + (aim1/anumlm)*delx
      ENDDO
      WRITE (G_IO,99011) (xlable(i),i=1,numlab)
99011 FORMAT (' ',9X,5E12.4)
!
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)
99018 FORMAT (' ',18X,54A1)
99019 FORMAT (' ',15X,A1)
!
END SUBROUTINE PLOTCT