home *** CD-ROM | disk | FTP | other *** search
- 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
