home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP2.ZIP / STATNONP.ZIP / TIE.FOR < prev    next >
Text File  |  1985-11-29  |  2KB  |  79 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE TIE
  5. C
  6. C        PURPOSE
  7. C           CALCULATE CORRECTION FACTOR DUE TO TIES
  8. C
  9. C        USAGE
  10. C           CALL TIE(R,N,KT,T)
  11. C
  12. C        DESCRIPTION OF PARAMETERS
  13. C           R  - INPUT VECTOR OF RANKS OF LENGTH N CONTAINING VALUES
  14. C                1 TO N
  15. C           N  - NUMBER OF RANKED VALUES
  16. C           KT - INPUT CODE FOR CALCULATION OF CORRECTION FACTOR
  17. C                      1   SOLVE EQUATION 1
  18. C                      2   SOLVE EQUATION 2
  19. C           T  - CORRECTION FACTOR (OUTPUT)
  20. C                    EQUATION 1   T=SUM(CT**3-CT)/12
  21. C                    EQUATION 2   T=SUM(CT*(CT-1)/2)
  22. C                  WHERE CT IS THE NUMBER OF OBSERVATIONS TIED FOR A
  23. C                        GIVEN RANK
  24. C
  25. C        REMARKS
  26. C           NONE
  27. C
  28. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  29. C           NONE
  30. C
  31. C        METHOD
  32. C           VECTOR IS SEARCHED FOR SUCCESSIVELY LARGER RANKS. TIES ARE
  33. C           COUNTED AND CORRECTION FACTOR 1 OR 2 SUMMED.
  34. C
  35. C     ..................................................................
  36. C
  37.       SUBROUTINE TIE(R,N,KT,T)
  38.       DIMENSION R(1)
  39. C
  40. C        INITIALIZATION
  41. C
  42.       T=0.0
  43.       Y=0.0
  44.     5 X=1.0E38
  45.       IND=0
  46. C
  47. C        FIND NEXT LARGEST RANK
  48. C
  49.       DO 30 I=1,N
  50.       IF(R(I)-Y) 30,30,10
  51.    10 IF(R(I)-X) 20,30,30
  52.    20 X=R(I)
  53.       IND=IND+1
  54.    30 CONTINUE
  55. C
  56. C        IF ALL RANKS HAVE BEEN TESTED, RETURN
  57. C
  58.       IF(IND) 90,90,40
  59.    40 Y=X
  60.       CT=0.0
  61. C
  62. C        COUNT TIES
  63. C
  64.       DO 60 I=1,N
  65.       IF(R(I)-X) 60,50,60
  66.    50 CT=CT+1.0
  67.    60 CONTINUE
  68. C
  69. C        CALCULATE CORRECTION FACTOR
  70. C
  71.       IF(CT) 70,5,70
  72.    70 IF(KT-1) 75,80,75
  73.    75 T=T+CT*(CT-1.)/2.0
  74.       GO TO 5
  75.    80 T=T+(CT*CT*CT-CT)/12.0
  76.       GO TO 5
  77.    90 RETURN
  78.       END
  79.