      SUBROUTINE RDEGN
C SUBROUTINE TO READ IN THE DEPENDENCY RELATIONSHIPS AND ARRANGE
C  THEM IN ORDER OF INDEPENDENT PARAMETERS.
      DIMENSION IDPAR(2),INPAR(2,5),CNPAR(5)
      INCLUDE 'RFINE.PRM'
      INCLUDE 'D.INC'
      INCLUDE 'E.INC'
      INCLUDE 'CNSTRS.INC'
C
      INCLUDE 'SHIFT.INC'
C
   12 FORMAT('0TOO MANY DEPENDENCY RELATIONS. RUN ABORTED.')
   14 FORMAT('0IMPROPER DEPENDENCY INFORMATION. RUN ABORTED.')
c
      NDEGN=0
      KMAX=25000
      KP=1
  300 READ(IN,10)IDPAR,((INPAR(I,J),I=1,2),CNPAR(J),J=1,4)
   10 FORMAT(4I3,F12.0,3(2I4,F8.0)) 
      IF(IDPAR(1).EQ.0.AND.IDPAR(2).EQ.0)GO TO 360
      DO 350 I=1,5
        IF(INPAR(1,I).EQ.0.AND.INPAR(2,I).EQ.0.AND.CNPAR(I).EQ.0.)
     1     GO TO 300
        IF(INPAR(2,I).LT.0)GO TO 320
        KDEGN(KP)=IPAK(INPAR(1,I),INPAR(2,I),IDPAR(1),IDPAR(2)) 
        AA(KP+1)=CNPAR(I) 
        KP=KP+2
        NDEGN=NDEGN+1
        IF(KP.LT.KMAX)GO TO 350
C TOO MANY RELATIONS
  310   WRITE(IOUT,12)
        STOP
C 'RUN' INDICATED ON DEPENDENCY CARD. 
  320   IF(MOD(I,2).NE.0.OR.INPAR(1,I).NE.0)GO TO 340
        JMAX=-INPAR(2,I)
        JMIN=INPAR(2,I-1)+1
        IF(JMAX.LT.JMIN)GO TO 340
        DO 330 J=JMIN,JMAX 
          KDEGN(KP)=IPAK(INPAR(1,I),J,IDPAR(1),IDPAR(2))
          AA(KP+1)=0. 
          KP=KP+2
          NDEGN=NDEGN+1
          IF(KP .gt. KMAX)then
	    write(iout,12)
	    stop
          endif
  330   CONTINUE
        GO TO 350
C ERROR ON DEPENDENCY CARD
  340   WRITE(IOUT,14)
        STOP
  350 CONTINUE
      GO TO 300
C
C Sort Constraint relations to get constraints on Rigid Body parameters
c   to start of list.
c
360   nrig = 0
      do i = 1,ndegn
	j = 2*i - 1
	if (i3(kdegn(j)) .eq. 0) then
c i'th element has a rigid body as dependent variable - swap it to start
	  nrig=nrig + 1
	  k = 2*nrig -1
	  temp = aa(j)
	  aa(j) = aa(k)
	  aa(k) = temp
	  temp = aa(j+1)
	  aa(j+1) = aa(k+1)
	  aa(k+1) = temp
	endif
      enddo
c
c Sort the list of constraints with Rigid Body Dependent Parameters
c
      if (nrig .gt. 0) call sort(1,nrig)
C
C Sort Remaining Constraint Indicators to Group Them According to the
C  Independent Parameter.  
c
      call sort(nrig+1,ngegn)
      write(iout,16)ndegn
   16 format('0',i5,' Constraint relations read.')
      return
      end 
      subroutine sort(ist,iend)
C
C Routine to Shell sort a portion of the Constraint List from
c   Entry 'ist' to 'iend'
c
      include 'rfine.prm'
      include 'cnstrs.inc'
c
      ndelta=(iend - ist)/2+1
      do while (ndelta .gt. 0)
      nflp=1
      do while (nflp .ne. 0)
	nflp = 0
        do i=ist,iend
          j=i+ndelta
          if(j.gt.iend)go to 390
c should two items be swapped?
          ii1=2*i
          j1=2*j
          if(kdegn(j1-1).lt.kdegn(ii1-1))then
c yes - swap them
            temp=aa(ii1)
            aa(ii1)=aa(j1)
            aa(j1)=temp
            itemp=kdegn(ii1-1)
            kdegn(ii1-1)=kdegn(j1-1)
            kdegn(j1-1)=itemp
c note that swap occurred
            nflp=1
	  endif
        enddo
c if flip happened, repeat with same delta
  390 enddo
      if(ndelta.eq.1)then
	ndelta = 0
      else
c not done yet - reduce delta and resume searching
        ndelta=(ndelta+1)/2
      endif
      enddo
      return
      end
