PLTSCT Subroutine

public subroutine PLTSCT(Y, X, Char, N, D, Dmin, Dmax)

NAME

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

SYNOPSIS

   SUBROUTINE PLTSCT(Y,X,Char,N,D,Dmin,Dmax)

DESCRIPTION

pltsct(3f) yields a narrow-width (71-character) plot of y(i) versus
x(i):

  1. with special plot characters; and
  2. with only those points (x(i),y(i)) plotted
     for which the corresponding value of d(i)
     is between the specified values of dmin and dmax.

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

the '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.

the use of the subset definition vector d gives the data analyst
the capability of plotting subsets of the data, where the subset is
defined by values in the vector d.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_pltsct
use M_datapac, only : pltsct
implicit none
! call pltsct(x,y)
end program demo_pltsct

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
real(kind=wp), dimension(:) :: D
real(kind=wp) :: Dmin
real(kind=wp) :: Dmax

Source Code

      SUBROUTINE PLTSCT(Y,X,Char,N,D,Dmin,Dmax)
REAL(kind=wp) :: aim1 , airow , anumcm , anumlm , anumr , anumrm , Char ,     &
     &     cutoff , D , delx , dely , Dmax , Dmin , hold , X , xlable , &
     &     xmax , xmin , xwidth , Y
REAL(kind=wp) :: ylable , ylower , ymax , 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.
!                    --D      = THE  VECTOR
!                               WHICH 'DEFINES' THE VARIOUS
!                               POSSIBLE SUBSETS.
!                    --DMIN   = THE  VALUE
!                               WHICH DEFINES THE LOWER BOUND
!                               (INCLUSIVELY) OF THE PARTICULAR
!                               SUBSET OF INTEREST TO BE PLOTTED.
!                    --DMAX   = THE  VALUE
!                               WHICH DEFINES THE UPPER BOUND
!                               (INCLUSIVELY) OF THE PARTICULAR
!                               SUBSET OF INTEREST TO BE PLOTTED.
!     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
!             OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS
!             AND FOR ONLY A SPECIFIED SUBSET OF THE DATA.
!             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--FOR A GIVEN DUMMY INDEX I,
!              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
!              THEN THE CORRESPONDING POINT (X(I),Y(I))
!              WILL NOT BE PLOTTED.
!            --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--NOVEMBER  1975.
!     UPDATED         --FEBRUARY  1977.
!
!---------------------------------------------------------------------
!
CHARACTER(len=4) :: iline
CHARACTER(len=4) :: iaxisc
CHARACTER(len=4) :: iplotc
CHARACTER(len=4) :: jplotc
CHARACTER(len=4) :: sbnam1 , sbnam2
CHARACTER(len=4) :: alph11 , alph12 , alph21 , alph22 , alph31 , alph32
CHARACTER(len=4) :: alph41 , alph42 , alph51 , alph52
CHARACTER(len=4) :: blank , hyphen , alphai
!
      DIMENSION Y(:)
      DIMENSION X(:)
      DIMENSION Char(:)
      DIMENSION D(:)
      DIMENSION iline(72) , xlable(10)
      DIMENSION iplotc(37)
!
      DATA sbnam1 , sbnam2/'PLTS' , 'CT  '/
      DATA alph11 , alph12/'FIRS' , 'T   '/
      DATA alph21 , alph22/'SECO' , 'ND  '/
      DATA alph31 , alph32/'THIR' , 'D   '/
      DATA alph41 , alph42/'FOUR' , 'TH  '/
      DATA alph51 , alph52/'FIFT' , 'H   '/
      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,99014)
         WRITE (G_IO,99015)
         WRITE (G_IO,99017) alph41 , alph42 , sbnam1 , sbnam2
         WRITE (G_IO,99001) N
99001    FORMAT (' ','IS NON-NEGATIVE (WITH VALUE = ',I0,')')
         WRITE (G_IO,99014)
         RETURN
      ELSE
         IF ( N==1 ) THEN
            WRITE (G_IO,99014)
            WRITE (G_IO,99015)
            WRITE (G_IO,99017) alph41 , alph42 , sbnam1 , sbnam2
            WRITE (G_IO,99002) N
99002       FORMAT (' ','HAS THE VALUE 1')
            WRITE (G_IO,99014)
            RETURN
         ELSE
!
            hold = Y(1)
            DO i = 2 , N
               IF ( Y(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99014)
            WRITE (G_IO,99015)
            WRITE (G_IO,99017) alph11 , alph12 , sbnam1 , sbnam2
            WRITE (G_IO,99018) hold
            WRITE (G_IO,99014)
            RETURN
         ENDIF
 50      hold = X(1)
         DO i = 2 , N
            IF ( X(i)/=hold ) GOTO 100
         ENDDO
         WRITE (G_IO,99014)
         WRITE (G_IO,99015)
         WRITE (G_IO,99017) alph21 , alph22 , sbnam1 , sbnam2
         WRITE (G_IO,99018) hold
         WRITE (G_IO,99014)
         RETURN
      ENDIF
 100  hold = Char(1)
      DO i = 2 , N
         IF ( Char(i)/=hold ) GOTO 200
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99016)
      WRITE (G_IO,99017) alph31 , alph32 , sbnam1 , sbnam2
      WRITE (G_IO,99018) hold
      WRITE (G_IO,99014)
 200  hold = D(1)
      DO i = 2 , N
         IF ( D(i)/=hold ) GOTO 300
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99016)
      WRITE (G_IO,99017) alph51 , alph52 , sbnam1 , sbnam2
      WRITE (G_IO,99018) hold
      WRITE (G_IO,99014)
!
 300  DO i = 1 , N
         IF ( Y(i)<cutoff ) GOTO 400
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99017) alph11 , alph12 , sbnam1 , sbnam2
      WRITE (G_IO,99019)
      WRITE (G_IO,99020) cutoff
      WRITE (G_IO,99014)
      RETURN
 400  DO i = 1 , N
         IF ( X(i)<cutoff ) GOTO 500
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99017) alph21 , alph22 , sbnam1 , sbnam2
      WRITE (G_IO,99019)
      WRITE (G_IO,99020) cutoff
      WRITE (G_IO,99014)
      RETURN
 500  DO i = 1 , N
         IF ( Char(i)<cutoff ) GOTO 600
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99017) alph31 , alph32 , sbnam1 , sbnam2
      WRITE (G_IO,99019)
      WRITE (G_IO,99020) cutoff
      WRITE (G_IO,99014)
      RETURN
 600  DO i = 1 , N
         IF ( D(i)<cutoff ) GOTO 700
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99017) alph51 , alph52 , sbnam1 , sbnam2
      WRITE (G_IO,99019)
      WRITE (G_IO,99020) cutoff
      WRITE (G_IO,99014)
      RETURN
!
 700  DO i = 1 , N
         IF ( Dmin<D(i) .AND. D(i)<Dmax ) GOTO 800
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99017) alph51 , alph52 , sbnam1 , sbnam2
      WRITE (G_IO,99003)
99003 FORMAT (' ','HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
      WRITE (G_IO,99004) Dmin , Dmax
99004 FORMAT (' ','(',E15.8,',',E15.8,')',' AS DEFINED BY')
      WRITE (G_IO,99005)
99005 FORMAT (' ','THE SIXTH  AND SEVENTH INPUT ARGUMENTS.')
      WRITE (G_IO,99014)
      RETURN
!
 800  n2 = 0
      DO i = 1 , N
         IF ( Y(i)<cutoff .AND. X(i)<cutoff .AND. Char(i)<cutoff .AND.  &
     &        D(i)<cutoff ) THEN
            IF ( Dmin<D(i) .AND. D(i)<Dmax ) n2 = n2 + 1
            IF ( n2>=2 ) GOTO 900
         ENDIF
      ENDDO
      WRITE (G_IO,99014)
      WRITE (G_IO,99015)
      WRITE (G_IO,99006) alph11 , alph12 , alph21 , alph22 , alph31 ,    &
     &                  alph32 , alph51 , alph52
99006 FORMAT (' ','THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4)
      WRITE (G_IO,99007) sbnam1 , sbnam2
99007 FORMAT (' ','INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
      WRITE (G_IO,99008)
99008 FORMAT (' ','ARE SUCH THAT TOO MANY POINTS HAVE BEEN',            &
     &        ' EXCLUDED FROM THE PLOT.')
      WRITE (G_IO,99009) n2
99009 FORMAT (' ','ONLY ',I0,' POINTS ARE LEFT TO BE PLOTTED.')
      WRITE (G_IO,99014)
      RETURN
!
!-----START POINT-----------------------------------------------------
!
!     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS
!     BEEN SET TO 25 ROWS AND 49 COLUMNS.
!
 900  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,99010)
99010 FORMAT (' ')
      WRITE (G_IO,99011)
!
99011 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,99021) (iline(i),i=1,numcol)
      WRITE (G_IO,99022) 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
                  IF ( D(i)>=Dmin ) THEN
                     IF ( D(i)<=Dmax ) THEN
                        ymin = Y(i)
                        ymax = Y(i)
                        xmin = X(i)
                        xmax = X(i)
                        EXIT
                     ENDIF
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Char(i)<cutoff ) THEN
                  IF ( D(i)>=Dmin ) THEN
                     IF ( D(i)<=Dmax ) 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
            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 ( D(i)>=Dmin ) THEN
                        IF ( D(i)<=Dmax ) 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
               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,99012) ylable , iaxisc , (iline(icol),icol=1,icolmx)
99012    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,99022) blank
      DO icol = 1 , numcol
         iline(icol) = hyphen
      ENDDO
      DO icol = 1 , numcol , ixdel
         iline(icol) = alphai
      ENDDO
      WRITE (G_IO,99021) (iline(icol),icol=1,numcol)
      DO i = 1 , numlab
         aim1 = i - 1
         xlable(i) = xmin + (aim1/anumlm)*delx
      ENDDO
      WRITE (G_IO,99013) (xlable(i),i=1,numlab)
99013 FORMAT (' ',9X,5E12.4)
!
99014 FORMAT (' ','**************************************************', &
     &        '********************')
99015 FORMAT (' ','                   FATAL ERROR                    ')
99016 FORMAT (' ','               NON-FATAL DIAGNOSTIC               ')
99017 FORMAT (' ','THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,         &
     &        ' SUBROUTINE')
99018 FORMAT (' ','HAS ALL ELEMENTS = ',E15.8)
99019 FORMAT (' ','HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
99020 FORMAT (' ','VALUE OF ',E15.8)
99021 FORMAT (' ',18X,54A1)
99022 FORMAT (' ',15X,A1)
!
END SUBROUTINE PLTSCT