home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
fortran
/
library
/
pearson
/
corl.for
next >
Wrap
Text File
|
1986-09-19
|
7KB
|
183 lines
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