program prob4
    implicit none
    integer(8)::i, j, l, n, tmp, ans
    integer(8)::c(10)
    integer(8), allocatable::p(:,:)
    character(len=10)::S
    read(*,*) n
    allocate(p(n,10))
    do i = 1, n
        read(*,*) S
        c = 0
        do j = 1,10
            c(j) = int(ichar(S(j:j)) - ichar('a') + 1,kind=8)
        end do
        call heapsort(int(10,kind=8),c)
        p(i,:) = c
    end do
    !write(*,*) p(2,:)
    call lsort(n,p)
    ans = 0
    tmp = 0
    do i = 2,n
        do j = 1, 10
            if(p(i,j) .ne. p(i-1,j)) then
                tmp = 0
                exit
            else if(j == 10) then
                tmp = tmp + 1
                ans = ans + tmp
            end if
        end do
    end do
    !write(*,*) p(2,:)
    write(*,*) ans
    deallocate(p)
    stop
contains
    subroutine heapsort(n,array)
        implicit none
        integer(8),intent(in) :: n
        integer(8),intent(inout) :: array(1:n)
    
        integer(8) ::i,k,j,l
        double precision :: t
    
        if(n.le.0)then
        write(6,*)"Error, at heapsort"; stop
        endif
        if(n.eq.1)return
    
        l=n/2+1
        k=n
        do while(k.ne.1)
            if(l.gt.1)then
                l=l-1
                t=array(L)
            else
                t=array(k)
                array(k)=array(1)
                k=k-1
                if(k.eq.1) then
                    array(1)=t
                    exit
                endif
            endif
            i=l
            j=l+l
            do while(j.le.k)
                if(j.lt.k)then
                    if(array(j).lt.array(j+1))j=j+1
                endif
                if (t.lt.array(j))then
                    array(i)=array(j)
                    i=j
                    j=j+j
                else
                    j=k+1
                endif
            enddo
            array(i)=t
        enddo
    
        return
    end subroutine heapsort

    subroutine lsort(n,array)
        implicit none
        integer(8),intent(in) :: n
        integer(8),intent(inout) :: array(n,10)
    
        integer(8) ::i,k,j,l,m,mode
        integer(8)::t(10)
    
        if(n.le.0)then
        write(6,*)"Error, at lsort"; stop
        endif
        if(n.eq.1)return
    
        l=n/2+1
        k=n
        do while(k.ne.1)
            if(l.gt.1)then
                l=l-1
                t=array(l,:)
            else
                t=array(k,:)
                array(k,:)=array(1,:)
                k=k-1
                if(k.eq.1) then
                    array(1,:)=t
                    exit
                end if
            end if
            i=l
            j=l+l
            do while(j.le.k)
                if(j.lt.k)then
                    do m = 1, 10
                        if(array(j,m) > array(j+1,m)) then
                            exit
                        else if(array(j,m) < array(j+1,m)) then
                            j=j+1
                            exit
                        end if
                    end do
                end if
                mode = 0
                do m = 1, 10
                    if(t(m) > array(j,m)) then
                        exit
                    else if(t(m) < array(j,m)) then
                        mode = 1
                        exit
                    end if
                end do
                if (mode==1)then
                    array(i,:)=array(j,:)
                    i=j
                    j=j+j
                else
                    j=k+1
                end if
            end do
            array(i,:)=t
        end do

        return
    end subroutine lsort
end program

Measured memory_bytes: 10384