Cacher is the code snippet organizer for pro developers

PROGRAM A6Q2
!-------------------------------------------------
! finding order depending on the array index
!-------------------------------------------------

IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: A
INTEGER :: n, check, result

PRINT *, "ENTER THE ARRAY SIZE (n) : "
READ *, n



DO 
    IF (n .EQ. 0) EXIT
    IF (n .LT. 0) THEN
        PRINT *, "ARRAY CANNOT BE NEGATIVE"

    ELSE
        ALLOCATE(A(n), STAT=check)
        
        PRINT *, "ENTER ARRAY ELEMENTS : "
        READ *, A

        result = FindOrder(A, n)
        PRINT *, "Order depending on Array index: ", A 
        
        DEALLOCATE(A)
    END IF
END DO 

CONTAINS

INTEGER FUNCTION FindOrder(A, n)
    INTEGER, DIMENSION(:), INTENT(INOUT) :: A
    INTEGER, INTENT(IN) :: n
    INTEGER, DIMENSION(n) :: temp
    INTEGER :: i,j

    DO i = 1, n
        ! here we check temp array have any value at index i
        ! if the index of i greater than index of i great that temp index item
        ! we move the item to next index
        IF ((temp(A(i)) .gt. 0) .and. (i .gt. temp(A(i))) )  THEN   
            !PRINT *, "checking"
            temp(A(i) + 1) = i
        ELSE 
            temp(A(i)) = i
        END IF
    END DO

    A = temp

END FUNCTION FindOrder

END PROGRAM A6Q2

! -----------------------------------------------------
!   FINDING THE NEXT PERMUTATION.
!------------------------------------------------------
PROGRAM A6Q2
    IMPLICIT NONE
    INTEGER, DIMENSION(:), ALLOCATABLE :: A
    INTEGER :: n, check

    PRINT *, "ENTER THE ARRAY SIZE (n) : "
    READ *, n

    DO 
    IF (n .EQ. 0) EXIT
    IF (n .LT. 0) THEN
        PRINT *, "ARRAY CANNOT BE NEGATIVE"

    ELSE
        ALLOCATE(A(n), STAT=check)
        
        PRINT *, "ENTER ARRAY ELEMENTS : "
        READ *, A

        PRINT *, "PERMUTATION SEQUENCE :" 
        CALL NextPerm(A,n)
        
        
        DEALLOCATE(A)
    END IF
END DO 
    
    


CONTAINS
    SUBROUTINE NextPerm(A, n)
        INTEGER, INTENT(IN) :: A(:)
        INTEGER, INTENT(IN) :: n
        INTEGER             :: i, j, l, reminder
        INTEGER             :: idx(size(A,1)), stride(size(A,1))

        l = size(A,1)
        !PRINT *, l
        stride(1) = 1
        DO i = 2, l
            stride(i) = stride(i-1)*l
        END DO ! i

        DO i = 0,l ** l-1
            reminder = i
            DO  j=l,1,-1
                idx(j) = reminder / stride(j)
                reminder = reminder - idx(j) * stride(j)
            END DO ! j
            PRINT *, A(idx + 1)
        END DO ! i
    END SUBROUTINE

END PROGRAM A6Q2