      PROGRAM CORL
C ............................................................
C              Pearson Product Moment Correlation
C                 by Thomas Wm. Madron (1985)
C                       Denton, TX 76205
C PURPOSE:  To calculate a Matrix of  Pearson  Product  Moment
C      Correlation    coefficients,    means,   and   standard
C      deviations.  Data may be entered from a  disk  file  or
C      from  the keyboard (and may be optionally saved if from
C      the keyboard).   Results  may  be  sent  to  the  video
C      display,  the printer, or to a disk file and a standard
C      matrix file may be saved.  
C REMARKS:  CORL requires all data to be present.  As  written
C      it  can handle 100 variables, although if the amount of
C      memory  is  a  problem,  dimension  and   specification
C      statements  may be changed to reflect a smaller number.
C      The program will run faster if compiled to use an  8087
C      coprocessor.  In addition to providing normal output, a
C      primary  purpose  of  the  program  is  to  generate  a
C      standard matrix file for input to other programs.  
C      NOTE:    When  compiling  the  program  and  associated
C      subprograms,  use  the  $STORAGE:  2 and $DO66 compiler
C      options.  The first changes  the  default  for  integer
C      lengths  from 32 bits to 16 bits.  This reduces storage
C      requirements and speeds program execution.  The  second
C      option  changes the default method of handling DO loops
C      from the FORTRAN 77 conventions to FORTRAN 66  (FORTRAN
C      IV)  conventions.  This was probably not necessary, but
C      many of the programs and  subprograms  in  this  series
C      were derived from FORTRAN 66 sources and the precaution
C      was thought the better part of valor.  
C METHOD:  Any introductory statistics textbook describes  the
C      Product Moment Correlation in some detail.  
C SUBPROGRAMS REQUIRED:
C      SUBROUTINES:
C      CENTER (INPUT, OUTPUT, N)
C      CLS
C      CORR (N, NV, R, FMEAN, STD, T, FMT, INPDEV, IOUT, ND)
C      FILES (TITLE, IO, FILENM, STA)
C      HEADER
C      HELP (NCALL) [DUMMY IN THIS PROGRAM]
C      INPMNU (TITLE,IQ)
C      KEYBD (X, NV, NOBS, IOUT, IEND)
C      LOCATE (IROW, ICOL)
C      MOVE (FROM,LOC1,TO,LOC2,LENGTH)
C      OUTMNU (IOD, IDISK3, TITLE3)
C      PCDS (X, N, M, FH, IO, IDIAG, ND)
C      PRTS (X,N,M,NVAR,KH,ND,NSET,IDIAG)
C      SUBS (X, N, IO, ID)
C      VPRTS (TITLE,NVAR,X,NR,NC,FH,IDIAG,ND)
C      WAIT (NCALL)
C      WTMAT (R, FMEAN, STD, NV, DTFILE, FMT, TITLE,
C    1       IDISK4, IDIAG, N, LL, ND)
C      FUNCTIONS REQUIRED:
C      FUNCTION ICLS(IOUT)
C      FUNCTION INSTR (STRING, VALUE, LENVAL)
C      FUNCTION UPPER (CHARX)
C LOGICAL UNIT NUMBERS  FOR  FILES:    Six  (6)  Logical  Unit
C      Numbers (LUNs) are reserved for standard file handling:
C      5 - Video Display Output, opened for 'CON'.
C      6 - Line Printer Output, opened for 'LPT1'.
C      1 - IDISK1:  Raw data input file.
C      2 - IDISK2:  Raw data output file.
C      3 - IDISK3:  Output file for results (print image).
C      4 - IDISK4:  Standard Matrix output file.
C ............................................................
C     SPECIFICATION STATEMENTS
      CHARACTER YM*1, YD*1, YES*1, TITLE*64, TITLE1*28,
     1 TITLE2*28, TITLE3*28, TITLE4*28, UPPER, FST*80, SEC*80,
     2 FILENM*14, DTFILE*14, INPUT*80, OUTPUT*80, FMT*80
      INTEGER*2 NVAR(100), I, J
      REAL*4 R(100,100), FMEAN(100), STD(100)
      COMMON /FILEX/ IDISK1,IDISK2,IDISK3,IDISK4
      COMMON /HEAD/ FST, SEC
C     MAXIMUM DIMENSION OF ROWS IN R:
      ND = 100
C     DISK FILES:
      IDISK1 = 1
      IDISK2 = 2
      IDISK3 = 3
      IDISK4 = 4
C     INITIALIZE VARIABLES
      INPDEV = 0
      IOUT = 0
      YES = 'Y'
      LL = 80
      IDIAG = 0
      ICRT = 5
      IPRT = 6
      NCALL = 0
C     TITLES FOR FILESPEC REQUESTS
      TITLE1 =  'Input Data Filespecs        '
      TITLE2 =  'Output Data Filespecs       '
      TITLE3 =  'Output Results Filespecs    '
      TITLE4 =  'Output Matrix Filespecs     '
C     HEADER TITLES
      FST = 'Pearson Product Moment Correlation Program\'
      SEC = 'by Thomas Wm. Madron (1985)\' 
C     SETUP INPUT PARAMETERS
40    CALL HEADER
      WRITE (*,'('' Please Enter a Title for this Run:'')')
      READ (*,'(A)') TITLE
      WRITE (*,'('' How many variables will you need? ''\)')
      READ (*,'(I10)') NV
      IF (NV .GT. ND) THEN
           INPUT = '* * * Too Many Variables * * *\'
           CALL CENTER (INPUT, OUTPUT, LL)
           IROW = 10
           ICOL = 1
           CALL LOCATE (IROW, ICOL)
           WRITE (*,'(A)') OUTPUT
           CALL WAIT (NCALL)
           GO TO 40
      ENDIF
C     INITIALIZE NVAR(I)
      DO 50 I = 1,NV
           NVAR(I) = I
50    CONTINUE
      CALL INPMNU (TITLE, INPD)
      IF (INPD .EQ. 3) GO TO 100
      IF (INPD .EQ. 2) THEN
           CALL FILES (TITLE1, IDISK1, DTFILE, 'OLD')
           WRITE (*,
     1       '('' Please specify your data FORMAT: '')')
           READ (*,'(A)') FMT
      ELSEIF (INPD .EQ. 1) THEN
           WRITE (*,'('' Do You want to save the Data? ''\)')
           READ (*,'(A)') YD
           YD = UPPER(YD)
           IF (YD .EQ. YES) THEN
                CALL FILES (TITLE2, IDISK2, FILENM, 'NEW')
                IOUT = 2
           ENDIF
      ENDIF
C     SETUP OUTPUT PARAMETERS
      CALL OUTMNU (IOD, IDISK3, TITLE3)
      CALL HEADER
      WRITE (*,
     1 '('' Do you want to save the Matrix (y/n)? ''\)')
      READ (*,'(A)') YM
      YM = UPPER(YM)
      IF (YM .EQ. YES) THEN
           CALL FILES (TITLE4, IDISK4, FILENM, 'NEW')
      ENDIF
C     DO THE CORRELATIONS
      CALL CORR (N, NV, R, FMEAN, STD, T, FMT, INPD, IDISK1,
     * IOUT, ND)
      IF (IOUT .GE. 1) THEN
           CLOSE (IDISK2, STATUS='KEEP')
      ENDIF
      IF (IOD .EQ. ICRT) THEN
C          PRINT MEANS, STD. DEVS., & CORRELATIONS TO VIDEO
           CALL VPRTS (TITLE,NVAR,FMEAN,NV,1,'MEAN',IDIAG,
     1        NCALL,ND)
           CALL VPRTS (TITLE,NVAR,STD,NV,1,'STD.',IDIAG,
     1        NCALL,ND)
           CALL VPRTS (TITLE,NVAR,R,NV,NV,'CORL',IDIAG,
     1        NCALL,ND)
      ELSE
C     PRINT MEANS, STANDARD DEVIATIONS, AND CORRELATIONS
C          IF IOD =
C               IPRT, THEN OUTPUT IS TO THE PRINTER
C               IDISK3, THEN OUTPUT IS TO DISK
           WRITE (IOD,'('' '',A)') TITLE
           CALL PRTS (FMEAN,NV,1,NVAR,'MEANS   ',ND,IOD,IDIAG)
           CALL PRTS (STD,NV,1,NVAR,'STD.DEV.',ND,IOD,IDIAG)
           II = ICLS (IOD)
           WRITE (IOD,'('' '',A)') TITLE
           CALL PRTS (R,NV,NV,NVAR,'CORRELAT',ND,IOD,IDIAG)
      ENDIF
C     SAVE THE MATRIX IN STANDARD DISK FORMAT, IF OPTED
      IF (YM .EQ. YES) THEN
           CALL WTMAT (R, FMEAN, STD, NV, DTFILE, FMT, TITLE,
     1       IDISK4, IDIAG, N, LL, ND)
      ENDIF
100   CALL CLS
      STOP 'FINI'
      END
      SUBROUTINE HELP (NCALL)
C     DUMMY SUBROUTINE NOT APPLICABLE TO CORL.FOR
      RETURN
      END
