program f90_num
    implicit none
    integer,allocatable::kakom(:,:)
    integer,allocatable::jnd(:)
    integer::NODT,NELT,nod
    integer::ne,i,j
    character :: linebuf*1000

    open(11,file='fnameT1.txt',status='old')
    read(11,*) NODT,NELT,nod
    allocate(kakom(1:NELT,1:nod))
    allocate(jnd(1:NODT))
    do ne=1,NELT
        read(11,*) (kakom(ne,j),j=1,nod)
    end do
    close(11)

        print "('NODT=',i0,' NELT=',i0,' nod=',i0)",NODT,NELT,nod


    !Minimization of band width
    call optnum(kakom,jnd,NODT,NELT,nod)

    do i=1,NODT
        print "('original=',i0,' new=',i0)",i,jnd(i)
    end do

    open(12,file='fnameT2.txt',status='replace')
    do i=1,NODT
        write(linebuf,*) i,',',jnd(i)
        call del_spaces(linebuf)
        write (12,'(a)') trim(linebuf)
    end do
    close(12)

    stop

contains

    subroutine optnum(kakom,jnd,NODT,NELT,nod)
        integer::NODT,NELT,nod
        integer::kakom(1:NELT,1:nod),jnd(1:NODT)

        integer::i,j,k,ii,jj,iii,ik
        integer::idiff,ndiff,jnti,jsub,jjt,mem1,minmax,max,k4,k5
        integer::jmem(1:NODT),memjt(1:NODT*8),newjt(1:NODT),joint(1:NODT)

        idiff=NODT
        do j=1,NODT
            jmem(j)=0
        end do
        do j=1,NELT
            do i=1,nod
        print "('j=',i0,' i=',i0)",j,i
                jnti=kakom(j,i)
                if(jnti==0)exit
                jsub=(jnti-1)*8
                do ii=1,nod
                    if(ii==i)cycle
                    jjt=kakom(j,ii)
                    if(jjt==0)exit
                    mem1=jmem(jnti)
                    if(mem1/=0)then
                        do iii=1,mem1
                            if(memjt(jsub+iii)==jjt)exit
                        end do
                    end if
                    if(memjt(jsub+iii)/=jjt)then
                        jmem(jnti)=jmem(jnti)+1
                        memjt(jsub+jmem(jnti))=jjt
                        if(abs(jnti-jjt)>idiff)idiff=abs(jnti-jjt)
                    end if
                end do
            end do
        end do

        minmax=idiff
        do ik=1,NODT
            do j=1,NODT
                joint(j)=0
                newjt(j)=0
            end do
            max=0
            i=1
            newjt(1)=ik
            joint(ik)=1
            k=1
            do
                k4=jmem(newjt(i))
                if(k4/=0)then
                    jsub=(newjt(i)-1)*8
                    do jj=1,k4
                        k5=memjt(jsub+jj)
                        if(joint(k5)>0)cycle
                        k=k+1
                        newjt(k)=k5
                        joint(k5)=k
                        ndiff=abs(i-k)
                        if(ndiff>=minmax)exit
                        if(ndiff>max)max=ndiff
                    end do
                end if
                if(ndiff>=minmax)exit
                if(k==NODT)exit
                i=i+1
            end do
            if(ndiff>=minmax)cycle
            if(k==NODT)minmax=max
            do j=1,NODT
                jnd(j)=joint(j)
            end do
        end do

    end subroutine optnum


    subroutine del_spaces(s)
        character (*), intent (inout) :: s
        character (len=len(s)) tmp
        integer i, j
        j = 1
        do i = 1, len(s)
            if (s(i:i)==' ') cycle
            tmp(j:j) = s(i:i)
            j = j + 1
        end do
        s = tmp(1:j-1)
    end subroutine del_spaces


end program f90_num