!     Last change:  DOS   3 Aug 2000    6:19 pm
!                                       *** copyright 2000 ***
! *** filename ptrend.f95               *** John F. Monahan **
!                                       **********************
      PROGRAM PTREND
!  PERMUTATION TEST FOR TREND -- GET THE (ONE-SIDED) P-VALUE                              
!
      IMPLICIT NONE
      INTEGER, PARAMETER :: N = 10      ! SAMPLE SIZE
      REAL, DIMENSION(N) :: Y
      REAL SXY,SXYORG,FACT
      INTEGER, DIMENSION(N) :: LIST,M
      INTEGER I,KPVAL,LAST
!  
  20  FORMAT(' PERMUTATION P-VALUE FROM CORRELATION TEST'   &
     &      /'   WITH SAMPLE SIZE M=',I3,6X,'P-VALUE',F8.4)
!W  21  FORMAT(I4,F8.3,2X,10I3)
!
!                   LET'S USE THESE NUMBERS FOR A TEST PROBLEM                                                    
      DATA Y/ 52.43, 73.77, 74.88, 59.92, 47.15, 55.97, 59.54, 98.65, &
     &        52.27, 101.34 /
!
      OPEN( UNIT=6, FILE='ptrend.out' )
!
!                   EVALUATE THE TEST STATISTIC FROM THE ORIGINAL DATA                                                    
      SXY = 0.
      DO I = 1,N
      SXY = SXY + Y(I)*REAL(I)
      END DO  ! LOOP ON I
      SXYORG = SXY
!                                                                       
!                   INITIALIZE COUNTER FOR P-VALUE
      KPVAL = 0
!                   INITIALIZE PERMUTATION AND FLAG (LAST)                                                    
      FACT = 1.
      DO I = 1,N
      FACT = FACT * REAL(I)
      LIST(I) = I                                                       
      END DO  ! LOOP ON I
      LAST = 0                                                          
!W      WRITE(6,21) LAST,SXY,(LIST(I),I=1,N)
!                   RETURN HERE TO START PROCESSING                                                     
      DO            ! *** UNRESTRICTED DO ***
!                   EVALUATE STATISTIC FOR THIS PERMUTATION                                                    
      SXY = 0.
      DO I = 1,N
      SXY = SXY + Y(I)*REAL( LIST(I) )
      END DO  ! LOOP ON I
!
!                   COUNT FOR P-VALUE                                                    
      IF( SXY .LT. SXYORG ) KPVAL = KPVAL + 1
!                   GET NEXT PERMUTATION                                                    
      CALL PERMNX(LIST,M,N,LAST)
!W      WRITE(6,21) LAST,SXY,(LIST(I),I=1,N)
!                   ARE WE DONE?                                                    
      IF( LAST .NE. 1 ) EXIT
      END DO ! UNRESTRICTED DO
!                   COMPUTE P-VALUE
      SXY = REAL(KPVAL) / FACT
!                   WRITE OUT RESULTS                                                    
      WRITE(6,20) N,SXY
!                                                                       
      STOP
      END PROGRAM PTREND
      SUBROUTINE PERMNX(M,D,N,RT)
!  SUBROUTINE PERMNX  --  COMPUTES THE NEXT PERMUTATION OF N ITEMS
!  FORTRAN TRANSLATION OF ALGOL PROCEDURE VECTORPERM (WELLS' METHOD)
!  J. BOOTHROYD (1967) ALGORITHM 29: PERMUTATION OF THE ELEMENTS OF A
!  VECTOR, THE COMPUTER JOURNAL, VOL. 10, P. 311
!  MARK B. WELLS (1961) GENERATION OF PERMUTATIONS BY TRANSPOSITION,
!  MATH. COMP., VOL. 15, PP. 192-195.
!
!  J F MONAHAN (DEC,1984) DEPT OF STAT, N C S U, RALEIGH, N C 27695-8203
!     RECODED MARCH 2000 FOR FORTRAN 95
!
!   M   INTEGER VECTOR   IN/OUT   VECTOR OF ITEMS TO BE PERMUTED        
!   D   INTEGER VECTOR   AUX      INVERSION TABLE TO RUN ALGORITHM
!   N   INTEGER          IN       LENGTH OF VECTOR TO BE PERMUTED
!   RT  INTEGER          IN       RT = 0  START PERMUTATIONS
!                        OUT      RT = 0  DONE WITH PERMUTATIONS
!                        IN/OUT   RT = 1  CONTINUING, GENERATE NEXT
!
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: N
      INTEGER, INTENT(IN OUT) :: RT
      INTEGER, DIMENSION(N), INTENT(IN OUT) :: M,D
      INTEGER DK,T,K,J,KL
!                          BRANCH TO 2 IF WE ARE IN THE MIDDLE OF THINGS
      IF( RT .EQ. 0 ) THEN
!                          INITIALIZE INVERSION TABLE                   
      DO K = 1,N
      D( K ) = 0
      END DO  ! LOOP ON K
                      END IF ! ( RT .EQ. 0 )
!                          START MAIN PART OF CODE                      
      RT = 0
      J = -1
      KL = 1                                                            
      DO K = 2,N
      DK = D( K )                                                       
      IF( DK .NE. KL ) THEN             ! SET FLAG AND BREAK FROM LOOP
      RT = 1
      EXIT
                       END IF ! ( DK .NE. KL )
      D( K ) = 0                                                        
      J = -J                                                            
      KL = K
      END DO  ! LOOP ON K
!                          IF WE COMPLETE THE LOOP, DONE PERMUTING      
      IF( RT .EQ. 0 ) RETURN
      D( K ) = DK + 1
      DK = D( K )                                                       
      IF( J .NE. 1 .AND. DK .GT. 2 ) KL = K - D( K )                    
!                                                                       
!                        SWITCH THESE TWO ELEMENTS
      T = M( K )
      M( K ) = M( KL )                                                  
      M( KL ) = T                                                       
      RETURN                                                            
      END SUBROUTINE PERMNX
! *** end of filename ptrend.f95        *********************