DCORR: /*CORR 10*/ /*********************************************************************//*CORR 20*/ /* *//*CORR 30*/ /* TO COMPUTE MEANS, STANDARD DEVIATIONS, SUMS OF CROSS-PRODUCTS*//*CORR 40*/ /* OF DEVIATIONS, AND CORRELATION COEFFICIENTS. *//*CORR 50*/ /* *//*CORR 60*/ /*********************************************************************//*CORR 70*/ PROCEDURE (N,M,IO,X,XBAR,STD,RX,R,B) OPTIONS (REORDER); /*CORR 80*/ DECLARE /*CORR 90*/ ERROR EXTERNAL CHARACTER (1), /*CORR 100*/ (I,IO,J,K,KK,M,N) /*CORR 110*/ FIXED BINARY, /*CORR 120*/ (X(*,*),D(M),FN,FKK) /*CORR 130*/ FLOAT BINARY, /*CORR 140*/ (R(*,*),RX(*,*),XBAR(*),STD(*),B(*),T(M)) /*CORR 150*/ /* BINARY FLOAT; /*SINGLE PRECISION VERSION /*S*//*CORR 160*/ BINARY FLOAT (53); /*DOUBLE PRECISION VERSION /*D*//*CORR 170*/ /* *//*CORR 180*/ ERROR='0'; /*CORR 190*/ IF N <= 0 | M <= 0 /* THE NUMBER OF OBSERVATIONS *//*CORR 200*/ THEN DO; /* OR THE NUMBER OF VARIABLES *//*CORR 210*/ ERROR='1'; /* ARE LESS THAN OR EQUAL TO *//*CORR 220*/ GO TO FIN; /* ZERO. *//*CORR 230*/ END; /*CORR 240*/ FN =N; /* INITIALIZATION *//*CORR 250*/ T =0.0; /*CORR 260*/ DO I = 1 TO M; /*CORR 270*/ B(I) =0.0; /*CORR 280*/ DO J = 1 TO M; /*CORR 290*/ R(I,J)=0.0; /*CORR 300*/ END; /*CORR 310*/ END; /*CORR 320*/ IF IO ^= 0 /*CORR 330*/ THEN DO; /*CORR 340*/ DO J = 1 TO M; /* DATA IS ALREADY IN CORE *//*CORR 350*/ DO I = 1 TO N; /*CORR 360*/ T(J) =T(J)+X(I,J); /*CORR 370*/ END; /*CORR 380*/ XBAR(J)=T(J); /*CORR 390*/ T(J) =T(J)/FN; /*CORR 400*/ END; /*CORR 410*/ DO I = 1 TO N; /*CORR 420*/ DO J = 1 TO M; /*CORR 430*/ D(J) =X(I,J)-T(J); /*CORR 440*/ B(J) =B(J)+D(J); /*CORR 450*/ END; /*CORR 460*/ DO J = 1 TO M; /*CORR 470*/ DO K = J TO M; /*CORR 480*/ R(J,K)=R(J,K)+D(J)*D(K); /*CORR 490*/ END; /*CORR 500*/ END; /*CORR 510*/ END; /*CORR 520*/ GO TO CALC; /*CORR 530*/ END; /*CORR 540*/ /* *//*CORR 550*/ /* READ OBSERVATIONS AND CALCULATE TEMPORARY MEANS *//*CORR 560*/ /* *//*CORR 570*/ IF N < M /*CORR 580*/ THEN KK =N; /*CORR 590*/ ELSE KK =M; /*CORR 600*/ FKK =KK; /*CORR 610*/ DO I = 1 TO KK; /*CORR 620*/ CALL DAT2 (M,D); /*CORR 630*/ DO J = 1 TO M; /*CORR 640*/ T(J) =T(J)+D(J); /*CORR 650*/ RX(I,J)=D(J); /*CORR 660*/ END; /*CORR 670*/ END; /*CORR 680*/ DO J = 1 TO M; /*CORR 690*/ XBAR(J)=T(J); /*CORR 700*/ T(J) =T(J)/FKK; /*CORR 710*/ END; /*CORR 720*/ /* *//*CORR 730*/ /* CALCULATE SUMS OF CROSS-PRODUCTS OF DEVIATIONS FROM *//*CORR 740*/ /* TEMPORARY MEANS FOR M OBSERVATIONS. *//*CORR 750*/ /* *//*CORR 760*/ DO I = 1 TO KK; /*CORR 770*/ DO J = 1 TO M; /*CORR 780*/ D(J) =RX(I,J)-T(J); /*CORR 790*/ END; /*CORR 800*/ DO J = 1 TO M; /*CORR 810*/ B(J) =B(J)+D(J); /*CORR 820*/ DO K = J TO M; /*CORR 830*/ R(J,K)=R(J,K)+D(J)*D(K); /*CORR 840*/ END; /*CORR 850*/ END; /*CORR 860*/ END; /*CORR 870*/ IF N > KK /*CORR 880*/ /* *//*CORR 890*/ /* READ THE REST OF THE OBSERVATIONS ONE AT A TIME, SUM THE *//*CORR 900*/ /* OBSERVATIONS, AND CALCULATE SUMS OF CROSS PRODUCTS OF *//*CORR 910*/ /* DEVIATIONS FROM TEMPORARY MEANS. *//*CORR 920*/ /* *//*CORR 930*/ THEN DO; /*CORR 940*/ DO I = 1 TO N-KK; /*CORR 950*/ CALL DAT2 (M,D); /*CORR 960*/ DO J = 1 TO M; /*CORR 970*/ XBAR(J)=XBAR(J)+D(J); /*CORR 980*/ D(J) =D(J)-T(J); /*CORR 990*/ B(J) =B(J)+D(J); /*CORR1000*/ END; /*CORR1010*/ DO J = 1 TO M; /*CORR1020*/ DO K = J TO M; /*CORR1030*/ R(J,K)=R(J,K)+D(J)*D(K); /*CORR1040*/ END; /*CORR1050*/ END; /*CORR1060*/ END; /*CORR1070*/ END; /*CORR1080*/ /* *//*CORR1090*/ /* ADJUST SUMS OF CROSS-PRODUCTS OF DEVIATIONS FROM TEMP. MEANS *//*CORR1100*/ /* *//*CORR1110*/ CALC: /*CORR1120*/ DO I = 1 TO M; /*CORR1130*/ XBAR(I)=XBAR(I)/FN; /* CALCULATE MEANS. *//*CORR1140*/ DO J = I TO M; /*CORR1150*/ RX(I,J)=R(I,J)-B(I)*B(J)/FN; /*CORR1160*/ RX(J,I)=RX(I,J); /*CORR1170*/ END; /*CORR1180*/ STD(I)=SQRT(ABS(RX(I,I))); /*CORR1190*/ /* *//*CORR1200*/ /* COPY THE DIAGONAL OF THE MATRIX OF SUMS OF CROSS PRODUCTS OF *//*CORR1210*/ /* DEVIATIONS FROM THE MEANS. *//*CORR1220*/ /* *//*CORR1230*/ B(I) =RX(I,I); /*CORR1240*/ END; /*CORR1250*/ /* *//*CORR1260*/ /* COMPUTE CORRELATION COEFFICIENTS *//*CORR1270*/ /* *//*CORR1280*/ DO J = 1 TO M; /*CORR1290*/ DO K = J TO M; /*CORR1300*/ FKK =STD(J)*STD(K); /*CORR1310*/ IF FKK= 0.0 /*CORR1320*/ THEN DO; /*CORR1330*/ ERROR='2'; /* SOME VARIANCES ARE ZERO *//*CORR1340*/ R(J,K)=0.0; /*CORR1350*/ END; /*CORR1360*/ ELSE R(J,K)=RX(J,K)/FKK; /*CORR1370*/ R(K,J)=R(J,K); /*CORR1380*/ END; /*CORR1390*/ END; /*CORR1400*/ /* *//*CORR1410*/ /* COMPUTE STANDARD DEVIATIONS *//*CORR1420*/ /* *//*CORR1430*/ IF N=1 /*CORR1440*/ THEN DO; /*CORR1450*/ DO I=1 TO N; /*CORR1460*/ STD(I) =0; /*CORR1470*/ END; /*CORR1480*/ GO TO FIN; /*CORR1490*/ END; /*CORR1500*/ FN =SQRT(N-1); /*CORR1510*/ DO I = 1 TO M; /*CORR1520*/ STD(I)=STD(I)/FN; /*CORR1530*/ END; /*CORR1540*/ FIN: /*CORR1550*/ RETURN; /*CORR1560*/ END DCORR; /*END OF PROCEDURE DCORR *//*CORR1570*/