C
C**************************  TOPOL  ************************************
C
C  routine per l'analisi topologica del reticolo nel caso simmetrico
C  
C  tutti i cicli del tipo GO TO sono stati opportunamente cambiati 
C  in modo da rendere la subroutine completamente strutturata.
C
C***********************************************************************
C
      SUBROUTINE topol(N,NTERM,TRIANG,JA,IA,NE,N1)
C
      IMPLICIT    NONE
      INTEGER     I,J,K,L,M,III,KK,KKK,MM,MCONTR
      INTEGER     N,N1,NE,NTERM
      INTEGER     I1(3)
      INTEGER     IA(*),JA(*),TRIANG(3,*)
      logical     continua
C
C  fissa gli elementi diagonali a distanza costante N1
C        
      NTERM=N1*N
      DO I=1,NTERM
          JA(I)=0
      END DO
      JA(1)=1
      DO K=1,NTERM-1
         IF (K/N1*N1 .EQ. K) JA(K+1)=K/N1+1
      END DO
C
C  analizza tutti i triangoli ( NE )
C
      DO 400 K=1,NE
         DO I=1,3
            I1(I)=TRIANG(I,K)
         END DO
C
C  ordina i nodi dell'elemento in senso crescente 
C
        do j=1,3
	      do i=1,2
	           if (I1(i) .gt. I1(i+1)) then
		     kk=I1(i);
		     I1(i)=I1(i+1);
		     I1(i+1)=kk;
		   endif
	      end do
	end do      
C
C  
C  genera il vettore JA
C
         DO 6 I=1,2
            J=I+1
            DO 7 L=J,3
               M=N1*(I1(I)-1)+L-J+2
               MCONTR=N1*I1(I)
               continua=.false.
               do while ((((I1(L)-JA(M)).lt.0).or.((I1(L)-JA(M)).gt.0))
     1      .and.(.not.continua) ) 
                    if ((I1(L)-JA(M)).gt.0) then
                        IF(JA(M).EQ.0) then
                           JA(M)=I1(L)
                           continua=.true.
                        else
                            m=m+1
                            if (M-MCONTR.GE.0) then
                                III=MCONTR/N1
                                WRITE(6,101)III,K
                                stop
                            else
                              continua=.false.
                            end if
                         end if
                     elseif ((I1(L)-JA(M)).lt.0) then
                         mm=m
                         mm=mm+1
                         if (M-MCONTR.GE.0) then
                             III=MCONTR/N1
                             WRITE(6,101)III,K
                             stop
                          else
                          do while ((JA(MM).gt.0).or.(JA(MM).lt.0))
                             mm=mm+1
                             if (M-MCONTR.GE.0) then
                                III=MCONTR/N1
                                WRITE(6,101)III,K
                                stop
                             end if
                           end do
                           do while (JA(MM).eq.0) 
                             ja(mm)=ja(mm-1)
                             mm=mm-1
                             do while (mm.gt.m) 
                                ja(mm)=ja(mm-1)
                                mm=mm-1
                             end do
                           end do
                           end if
                             ja(m)=i1(l)
                      end if
                 end do
    7       CONTINUE
    6    CONTINUE
  400 CONTINUE
                         

C
C  costruisce il vettore IA
C
      IA(1)=1
      M=1
      J=1
      DO 20 K=1,NTERM,N1
         DO 21 I=1,N1
            if (JA(K+I-1).ne.0) then
            M=M+1
            end if
   21    CONTINUE
         J=J+1
         IA(J)=M
   20 CONTINUE
C
C  compatta il vettore JA eliminando gli zeri
C
      M=0
      DO 14 K=1,NTERM
         IF(JA(K).NE.0) then
            M=M+1
            JA(M)=JA(K)
         end if
   14 CONTINUE
      NTERM=M
C
      RETURN
  101 FORMAT(1X,'RIGA = ',I6,' TRIANGOLO = ',I6,'  AUMENTARE N1 ')
      END
