//AGOSTINO JOB /*JOBPARM S=8,R=2048,L=4 //STEP1 EXEC FORTVCLG,RC=1024K,RL=1024K,RG=3072K, // PARM.FORT='LANGLVL(77),NOMAP,NOXREF,OPTIMIZE(1)', // PARM.LKED='LET' //FORT.SYSIN DD * IMPLICIT REAL*8(A-H,O-Z) DIMENSION ARRAY(2000), QUANT(2000) ,PROB(2000) DIMENSION DX(2000), DY(2000) , DZ(2000) DIMENSION DT(2000), DL1(2000) ,INDEX(2000) DIMENSION DL2(2000), DL3(2000) ,DL4(2000) IPRINT = 6 ITEMP =15 IDISK =16 IREAD = 5 PI = 4.D0*DATAN(1.D0) C-------------------------------------------------- C READ TEST DATA C--------------------------------------------------- OPEN(IDISK,ERR=3000,STATUS='OLD',ACCESS='SEQUENTIAL', # IOSTAT=IERROR) C--------------------------------------------------- C READ TEST DATA C--------------------------------------------------- 9 DO 1 K=1,2000 READ(IDISK,*,ERR=2010,IOSTAT=IERROR,END=2) DL1(K), INDEX(K) 1 CONTINUE 2 NDATA = K - 2 C--------------------------------------------------- C WRITE DATA C-------------------------------------------------- DO 3 I= 1,NDATA ARRAY(I) = DL1(I) WRITE(6,*) ARRAY(I), I 3 CONTINUE C C----------------------------------------------------------- C COMPUTE THE TEST STATISTIC C----------------------------------------------------------- SUM1 = 0.D0 SUM2 = 0.D0 CALL SORT8(ARRAY,NDATA) DO 4 I=1,NDATA SUM1 = SUM1 + (I - (DFLOAT(NDATA) + 1)/2.D0) * ARRAY(I) C WRITE(6,*) SUM1 ,I 4 CONTINUE CALL XMEAN(ARRAY,NDATA,XBAR) DO 5 I=1,NDATA SUM2 = SUM2 + ( ARRAY(I) - XBAR) **2 C WRITE(6,*) SUM2 ,I 5 CONTINUE SQRN = DSQRT(DFLOAT(NDATA)) S = DSQRT( SUM2 /(DFLOAT(NDATA)) ) DENOM = S * (DFLOAT(NDATA))**2 D = SUM1 / DENOM C----------------------------------------------------------- C COMPUTE THE STANDARDIZED VERSION OF D C----------------------------------------------------------- Y = SQRN * (D - 1 /(2 * DSQRT(PI))) /(0.02998598D0) C----------------------------------------------------------- C WRITE RESULTS FOR D'AGOSTINO TEST FOR ASSESSING NORMALITY C----------------------------------------------------------- WRITE(IPRINT,100) WRITE(IPRINT,101) XBAR , S WRITE(IPRINT,110) D WRITE(IPRINT,120) Y GO TO 2020 3000 WRITE(IPRINT,9040) IERROR GO TO 2020 C-------------------------------------------------- C CLOSE FILE ON DISK=10 C------------------------------------------------- 2010 WRITE(IPRINT,9030) IERROR GO TO 2020 2020 CLOSE(IDISK,ERR=4010,STATUS='KEEP',IOSTAT=IERROR) GO TO 2222 100 FORMAT('1','----------------------------D AGOSTINO TEST------------ #------------------------',//) 101 FORMAT(' ','MEAN VALUE IS =',F14.5,' STANDARD DEVIATION=',F14.5/) 110 FORMAT(' ','THE TEST STATISTIC D=',F14.5,/) 120 FORMAT(' ','THE STANDARDIZED VERSION OF D IS Y=',F14.5,/) 142 FORMAT(I8,1X,3(F10.3,2X),F20.4,F20.4,1X,3(F14.2)) 9030 FORMAT(' ','ERROR',I4,3X,'WHILE READING FILE OF RESULTS') 9040 FORMAT(' ','ERROR',I4,3X,'WHILE OPENING FILE OF RESULTS') 9070 FORMAT(' ','ERROR',I4,3X,'WHILE CLOSING FILE OF RESULTS') 4010 WRITE(IPRINT,9070) IERROR C------------------------------------------------------ C WRITE DATA C------------------------------------------------------ 2222 CONTINUE STOP END C SUBROUTINE CORREL(V1,V2,NDATA,COEFF) C------------------------------------------------------------ C COMPUTES CORRELATION COEFFICIENT OF TWO VECTORS V1 AND V2 C------------------------------------------------------------ IMPLICIT REAL*8(A-H,O-Z) DIMENSION V1(NDATA),V2(NDATA) SUMNUM = 0.0D0 SUMD1 = 0.0D0 SUMD2 = 0.0D0 CALL XMEAN(V1,NDATA,XBAR1) CALL XMEAN(V2,NDATA,XBAR2) DO 1 I=1,NDATA SUMNUM = SUMNUM + (V1(I) - XBAR1)*(V2(I) - XBAR2) SUMD1 = SUMD1 + (V1(I) - XBAR1)**2 SUMD2 = SUMD2 + (V2(I) - XBAR2)**2 1 CONTINUE COEFF = SUMNUM/(DSQRT(SUMD1*SUMD2)) RETURN END C SUBROUTINE XMEAN(ARRAY,NDATA,XBAR) IMPLICIT REAL*8(A-H,O-Z) DIMENSION ARRAY(NDATA) XBAR = 0.D0 DO 1 I=1,NDATA 1 XBAR=XBAR+ARRAY(I) XBAR=XBAR/DFLOAT(NDATA) RETURN END C SUBROUTINE SORT8(V1,N) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION V1(N) I = 1 1 I = I + I IF(I.LE.N) GO TO 1 M = I - 1 2 M = M / 2 IF(M.EQ.0) RETURN K = N - M DO 4 J=1,K L = J 5 IF(L .LT. 1) GO TO 4 IF(V1(L+M) .GE. V1(L)) GO TO 4 X = V1(L+M) V1(L+M) = V1(L) V1(L) = X L = L - M GO TO 5 4 CONTINUE GO TO 2 END //* //LKED.USERLIB DD DSN=A.M12129.SELIBOBJ,DISP=SHR //GO.FT22F001 DD DSN=A.M12128.MERTIKAS.FINAL, // UNIT=P3350,DISP=OLD //GO.FT16F001 DD DSN=A.M12128.MERTIKAS.VECT9, // UNIT=P3350,DISP=OLD //GO.FT15F001 DD DSN=&&TEMPPVA,DISP=(NEW,PASS), // UNIT=DASD,SPACE=(TRK,(1,1),RLSE), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000) //GO.SYSIN DD * 10 2.30 0.80 0.62 0.41 0.16 -0.10 -1.00 1.26 1.54 1.71 //