PLOT Subroutine

public subroutine PLOT(Y, X, n)

NAME

plot(3f) - [M_datapac:GENERIC_LINE_PLOT] yields a one-page printer
plot of Y(I) versus X(I)

SYNOPSIS

 Subroutine plot (X, Y, N)

Real(kind=wp) :: (In) ::  X(:)
Real(kind=wp) :: (In) ::  Y(:)
  Integer, Intent (In) ::  N

DESCRIPTION

This subroutine yields a one-page printer plot of Y(I) versus X(I).

Values in the vertical axis vector (Y) or the horizontal axis vector
(X) 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) are 'missing data', or when
we purposely want to ignore certain elements in the vector Y (or X)
for plotting purposes (That is, we do not want certain elements in
Y (or X) to be plotted). To cause specific elements in Y (or X)
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 plot subroutine.

OPTIONS

 Y     The REAL vector of (unsorted or sorted) observations
       to be plotted vertically.
 X     The REAL vector of (unsorted or sorted) observations
       to be plotted horizontally.
 N     The integer number of observations in the vector Y.

EXAMPLES

Sample program:

program demo_plot
use M_datapac, only : plot
implicit none
integer ::  i
real, allocatable ::  x(:), y(:)
  x=[(real(i),i=1,30)]
  y=0.075*(x**4)-0.525*(x**3)+0.75*(x**2)+2.40
  call plot(x,y,size(x))
  y=[(real(i)/10.0,i=1,30)]
  x=y**3.78-6*y**2.52+9*y**1.26
  call plot(x,y,size(x))
end program demo_plot

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

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: Y(:)
real(kind=wp), intent(in) :: X(:)
integer, intent(in) :: n

Common Blocks

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)
HIST (subroutine)
PLOT10 (subroutine)
PLOT6 (subroutine)
PLOT7 (subroutine)
PLOT8 (subroutine)
PLOT9 (subroutine)
PLOTC (subroutine)
PLOTCO (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 PLOT(Y,X,N)
REAL(kind=wp),intent(in) ::   X(:),  Y(:)
integer,intent(in) ::  n
REAL(kind=wp) :: aim1, cutoff, hold, ratiox, ratioy, x25, x75, xmax, xmid, xmin, ymax, ymin
REAL(kind=wp) :: ylable(11)
INTEGER i, iflag, ip2, j, k, mx, my, n2
!
!---------------------------------------------------------------------
!
CHARACTER(len=4) ::   IGRaph
CHARACTER(len=4) ::   sbnam1 , sbnam2
CHARACTER(len=4) ::   alph11 , alph12 , alph21 , alph22 , alph31 , alph32
CHARACTER(len=4) ::   blank , hyphen , alphai , alphax
CHARACTER(len=4) ::   alpham , alphaa , alphad , alphan , equal
COMMON /BLOCK1/ IGRaph(55,130)
!
DATA sbnam1 , sbnam2/'PLOT' , '    '/
DATA alph11 , alph12/'FIRS' , 'T   '/
DATA alph21 , alph22/'SECO' , 'ND  '/
DATA alph31 , alph32/'THIR' , 'D   '/
DATA blank , hyphen , alphai , alphax/' ' , '-' , 'I' , 'X'/
DATA alpham , alphaa , alphad , alphan , equal/'M' , 'A' , 'D' , 'N' , '='/
!
      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,99011)
         WRITE (G_IO,99012)
         WRITE (G_IO,99013) alph31 , alph32 , sbnam1 , sbnam2
         WRITE (G_IO,99002) N
99002    FORMAT (' ','IS NON-NEGATIVE (WITH VALUE = ',I0,')')
         WRITE (G_IO,99011)
         RETURN
      ELSE
         IF ( N==1 ) THEN
            WRITE (G_IO,99011)
            WRITE (G_IO,99012)
            WRITE (G_IO,99013) alph31 , alph32 , sbnam1 , sbnam2
            WRITE (G_IO,99003) N
99003       FORMAT (' ','HAS THE VALUE 1')
            WRITE (G_IO,99011)
            RETURN
         ELSE
!
            hold = Y(1)
            DO i = 2 , N
               IF ( Y(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99011)
            WRITE (G_IO,99012)
            WRITE (G_IO,99013) alph11 , alph12 , sbnam1 , sbnam2
            WRITE (G_IO,99014) hold
            WRITE (G_IO,99011)
            RETURN
         ENDIF
 50      hold = X(1)
         DO i = 2 , N
            IF ( X(i)/=hold ) GOTO 100
         ENDDO
         WRITE (G_IO,99011)
         WRITE (G_IO,99012)
         WRITE (G_IO,99013) alph21 , alph22 , sbnam1 , sbnam2
         WRITE (G_IO,99014) hold
         WRITE (G_IO,99011)
         RETURN
      ENDIF
!
 100  DO i = 1 , N
         IF ( Y(i)<cutoff ) GOTO 200
      ENDDO
      WRITE (G_IO,99011)
      WRITE (G_IO,99012)
      WRITE (G_IO,99013) alph11 , alph12 , sbnam1 , sbnam2
      WRITE (G_IO,99015)
      WRITE (G_IO,99016) cutoff
      WRITE (G_IO,99011)
      RETURN
 200  DO i = 1 , N
         IF ( X(i)<cutoff ) GOTO 300
      ENDDO
      WRITE (G_IO,99011)
      WRITE (G_IO,99012)
      WRITE (G_IO,99013) alph21 , alph22 , sbnam1 , sbnam2
      WRITE (G_IO,99015)
      WRITE (G_IO,99016) cutoff
      WRITE (G_IO,99011)
      RETURN
!
 300  n2 = 0
      DO i = 1 , N
         IF ( Y(i)<cutoff .AND. X(i)<cutoff ) THEN
            n2 = n2 + 1
            IF ( n2>=2 ) GOTO 400
         ENDIF
      ENDDO
      WRITE (G_IO,99011)
      WRITE (G_IO,99012)
      WRITE (G_IO,99004) alph11 , alph12 , alph21 , alph22
99004 FORMAT (' ','THE ',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,99011)
      RETURN
!
!-----START POINT-----------------------------------------------------
!
!     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
!
 400  DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               ymin = Y(i)
               ymax = Y(i)
               EXIT
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( Y(i)<ymin ) ymin = Y(i)
               IF ( Y(i)>ymax ) ymax = Y(i)
            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
               xmin = X(i)
               xmax = X(i)
               EXIT
            ENDIF
         ENDIF
      ENDDO
      DO i = 1 , N
         IF ( Y(i)<cutoff ) THEN
            IF ( X(i)<cutoff ) THEN
               IF ( X(i)<xmin ) xmin = X(i)
               IF ( X(i)>xmax ) xmax = X(i)
            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
               mx = ratiox*(X(i)-xmin) + 0.5_wp
               mx = mx + 7
               my = ratioy*(Y(i)-ymin) + 0.5_wp
               my = 43 - my
               IGRaph(my,mx) = alphax
            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,99008) (IGRaph(i,j),j=1,109)
!
         IF ( iflag==0 ) WRITE (G_IO,99009) ylable(k) ,(IGRaph(i,j),j=1,109)
      ENDDO
99008 FORMAT (' ',20X,109A1)
99009 FORMAT (' ',F20.7,109A1)
      WRITE (G_IO,99010) xmin , x25 , xmid , x75 , xmax
99010 FORMAT (' ',14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
!
99011 FORMAT (' ','**********************************************************************')
99012 FORMAT (' ','                   FATAL ERROR                    ')
99013 FORMAT (' ','THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,' SUBROUTINE')
99014 FORMAT (' ','HAS ALL ELEMENTS = ',E15.8)
99015 FORMAT (' ','HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
99016 FORMAT (' ','VALUE OF ',E15.8)
!
END SUBROUTINE PLOT