PLOTCO Subroutine

public subroutine PLOTCO(Y, N)

NAME

plotco(3f) - [M_datapac:GENERIC_LINE_PLOT] generate a line printer
autocorrelation plot

SYNOPSIS

   SUBROUTINE PLOTCO(Y,N)

       REAL(kind=wp) :: Y(:)
       INTEGER       :: N

DESCRIPTION

This routine yields a multi-page (if necessary) plot of the
autocorrelation coefficient r(k) versus the lag k.

There is no restriction on the maximum value of n for this routine.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_plotco
use M_datapac, only : plotco
implicit none
! call plotco(x,y)
end program demo_plotco

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) :: Y(:)
integer :: N

Common Blocks

HIST (subroutine)
PLOT10 (subroutine)
PLOT6 (subroutine)
PLOT7 (subroutine)
PLOT8 (subroutine)
PLOT9 (subroutine)
PLOTC (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 PLOTCO(Y,N)
REAL(kind=wp) :: hold, ratioy, Y(:), ylable(11), ymax, ymin
INTEGER i, iaxdel, idel, iflag, imax, imin, ix(25), ixmax, ixmin, iz, j, jmax, jmin, k, mx, my, N,  numpag
!
CHARACTER(len=4) :: IGRaph
CHARACTER(len=4) :: blank, star, hyphen, alphai
COMMON /BLOCK1/ IGRaph(55,130)
!
DATA blank, star, hyphen, alphai/' ', '*', '-', 'I'/
!
!     CHECK THE INPUT ARGUMENTS FOR ERRORS
!
      IF ( N<1 ) THEN
         WRITE (G_IO,99001)
         99001    FORMAT (' ***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE PLOTCO SUBROUTINE IS NON-POSITIVE *****')
         WRITE (G_IO,99002) N
         99002    FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****')
         RETURN
      ELSEIF ( N==1 ) THEN
         WRITE (G_IO,99003)
         99003    FORMAT (' ***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUMENT TO THE PLOTCO SUBROUTINE HAS THE VALUE 1 *****')
         RETURN
      ELSE
         hold = Y(1)
         DO i = 2 , N
            IF ( Y(i)/=hold ) GOTO 50
         ENDDO
         WRITE (G_IO,99004) hold
         99004    FORMAT (' ', &
         &'***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (A VECTOR) &
         &TO THE PLOTCO SUBROUTINE HAS ALL ELEMENTS = ',E15.8,' *****')
!
!-----START POINT-----------------------------------------------------
!
!     DETERMINE THE Y VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
!
 50      ymin = -1.0_wp
         ymax = 1.0_wp
         DO i = 1 , 11
            ylable(i) = FLOAT(6-i)/5.0_wp
         ENDDO
!
!     DETERMINE DISTANCES BETWEEN HORIZONTAL PLOT POINTS AND DISTANCES BETWEEN
!     HASH MARKS ON THE X AXIS
!
         IF ( N<=24 ) idel = 5
         IF ( 25<=N .AND. N<=40 ) idel = 3
         IF ( 41<=N .AND. N<=60 ) idel = 2
         IF ( 61<=N ) idel = 1
         iaxdel = 10
         IF ( N<=24 ) iaxdel = 5
         IF ( 25<=N .AND. N<=40 ) iaxdel = 15
!
!     DETERMINE THE NUMBER OF pages THE PLOT WILL TAKE UP
!
         numpag = ((N-1)/120) + 1
!
!     OPERATE  ON EACH page
!
         DO iz = 1 , numpag
!
!     DETERMINE THE X-AXIS VALUES
!
            ixmin = 0
            ixmax = N
            IF ( N<=24 ) THEN
               DO i = 1 , 25
                  ix(i) = i - 1
               ENDDO
            ELSEIF ( 25<=N .AND. N<=40 ) THEN
               DO i = 1 , 9
                  ix(i) = 5*(i-1)
               ENDDO
            ELSEIF ( 41<=N .AND. N<=60 ) THEN
               DO i = 1 , 13
                  ix(i) = 5*(i-1)
               ENDDO
            ELSE
               ixmax = 120*iz
               ixmin = ixmax - 120
               i = 0
               DO
                  i = i + 1
                  ix(i) = ixmin + 10*(i-1)
                  IF ( i>=13 ) EXIT
               ENDDO
            ENDIF
!
!     BLANK OUT THE GRAPH
!
            DO i = 1 , 55
               DO j = 1 , 130
                  IGRaph(i,j) = blank
               ENDDO
            ENDDO
!
!     PRODUCE THE Y AXIS
!
            DO i = 5 , 55
               IGRaph(i,10) = alphai
               IGRaph(i,130) = alphai
            ENDDO
            DO i = 5 , 55 , 5
               IGRaph(i,10) = hyphen
               IGRaph(i,130) = hyphen
            ENDDO
!
!     PRODUCE THE X AXIS
!
            DO j = 10 , 130
               IGRaph(55,j) = hyphen
               IGRaph(30,j) = hyphen
               IGRaph(5,j) = hyphen
            ENDDO
            DO j = 10 , 130 , iaxdel
               IGRaph(55,j) = alphai
               IGRaph(5,j) = alphai
            ENDDO
!
!     DETERMINE THE (X,Y) PLOT POSITIONS
!
            imin = ixmin + 1
            imax = ixmax
            IF ( imax>N ) imax = N
            ratioy = 50.0_wp/(ymax-ymin)
            DO i = imin , imax
               mx = MOD(i,120)
               mx = mx*idel
               IF ( mx==0 ) mx = 120
               mx = mx + 10
               my = ratioy*(Y(i)-ymin) + 0.5_wp
               my = 55 - my
               IGRaph(my,mx) = star
               jmax = MAX0(my,30)
               jmin = MIN0(my,30)
               DO j = jmin , jmax
                  IGRaph(j,mx) = star
               ENDDO
            ENDDO
!
!     WRITE OUT THE GRAPH
!
            WRITE (G_IO,99005)
99005       FORMAT ('1')
            IF ( iz==1 ) WRITE (G_IO,99006) N
99006       FORMAT ( ' THE TOTAL NUMBER OF POINTS PLOTTED (ON ALL pages) IS ',I0)
            IF ( iz>=2 ) WRITE (G_IO,99007)
99007       FORMAT (' THE PLOT ON THIS page IS A CONTINUATION OF THE PLOT ON THE PREVIOUS page')
            WRITE (G_IO,99008)
99008       FORMAT (' ')
            IF ( N<=24 ) WRITE (G_IO,99011) (ix(i),i=1,25)
            IF ( 25<=N .AND. N<=40 ) WRITE (G_IO,99012) (ix(i),i=1,9)
            IF ( 41<=N ) WRITE (G_IO,99013) (ix(i),i=1,13)
            DO i = 5 , 55
               iflag = i - (i/5)*5
               k = i/5
               IF ( iflag/=0 ) WRITE (G_IO,99009) (IGRaph(i,j),j=1,130)
99009          FORMAT (' ',130A1)
               IF ( iflag==0 ) WRITE (G_IO,99010) ylable(k) , (IGRaph(i,j),j=10,130)
99010          FORMAT (' ',F9.2,130A1)
            ENDDO
            IF ( N<=24 ) WRITE (G_IO,99011) (ix(i),i=1,25)
            IF ( 25<=N .AND. N<=40 ) WRITE (G_IO,99012) (ix(i),i=1,9)
            IF ( 41<=N ) WRITE (G_IO,99013) (ix(i),i=1,13)
         ENDDO
      ENDIF
99011 FORMAT (' ',6X,24(I4,1X),I4)
99012 FORMAT (' ',6X,8(I4,11X),I4)
99013 FORMAT (' ',6X,12(I4,6X),I4)
END SUBROUTINE PLOTCO