        subroutine DISPER
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
        integer I, J, K, KK, K3, L1
        real TEMPL, TEMSED, XTEMP1, XTEMP2
      do 220 K = 1, NCON
         if (JTURBG(K).eq.ITURBG(K).and.JTURBG(K).eq.0) go to 220
         if (JTURBG(K).ne.ITURBG(K)) go to 100
         write (TTYOUT(MACHNO),5000) JTURBG(K)
         go to 220
100      continue
         if (JTURBG(K).le.KOUNT.and.ITURBG(K).le.KOUNT) go to 110
         write (TTYOUT(MACHNO),5010) K
         go to 220
110      continue
         if (DSPG(K,NDAT).ne.0.0.and.XSTURG(K).ne.0.0.and.CHARLG(K).ne.
     &      0.0) go to 120
         write (TTYOUT(MACHNO),5020) K
         go to 220
120      continue
         J = JTURBG(K)
         I = ITURBG(K)
         if (J.eq.0) go to 180
         if (I.eq.0) go to 200
         if (TYPEG(J).ne.TYPEG(I)) go to 150
         if (TYPEG(J).eq.'B') go to 140
         TEMPL = 1000.*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATFL(I,J) = WATFL(I,J)+TEMPL
         WATFL(J,I) = WATFL(J,I)+TEMPL
         do 130 L1 = 1, KCHEM
            SEDFL(I,J,L1) = SEDFL(I,J,L1)+TEMPL*SEDCOL(J)
            SEDFL(J,I,L1) = SEDFL(J,I,L1)+TEMPL*SEDCOL(I)
130      continue
         go to 220
140      continue
         TEMPL = (((WATVOL(J)/VOLG(J))+(WATVOL(I)/VOLG(I)))/2.)*(DSPG(K,
     &      NDAT)*XSTURG(K)/CHARLG(K))
         WATFL(I,J) = WATFL(I,J)+TEMPL
         WATFL(J,I) = WATFL(J,I)+TEMPL
         go to 220
150      continue
         KK = J
         K3 = I
         if (TYPEG(J).eq.'B') go to 160
         KK = I
         K3 = J
160      continue
         TEMPL = (WATVOL(KK)/VOLG(KK))*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATFL(I,J) = WATFL(I,J)+TEMPL
         WATFL(J,I) = WATFL(J,I)+TEMPL
         TEMSED = TEMPL*SEDCOL(KK)
         do 170 L1 = 1, KCHEM
            SEDFL(K3,KK,L1) = SEDFL(K3,KK,L1)+TEMSED
            if (ALPHA(30,K3,L1).eq.0.0.and.ALPHA(30,KK,L1).eq.0.0) SEDFL
     &         (KK,K3,L1) = SEDFL(KK,K3,L1)+TEMSED
            if (ALPHA(30,K3,L1).eq.0.0.and.ALPHA(30,KK,L1).eq.0.0) go to
     &          170
            XTEMP1 = (ALPHA(29,K3,L1)+ALPHA(31,K3,L1))*SEDCOL(K3)/ALPHA(
     &         30,K3,L1)
            XTEMP2 = ALPHA(30,KK,L1)/(SEDCOL(KK)*(ALPHA(29,KK,L1)+ALPHA(
     &         31,KK,L1)))
            SEDFL(KK,K3,L1) = SEDFL(KK,K3,L1)+TEMSED*XTEMP1*XTEMP2
170      continue
         go to 220
180      continue
         if (TYPEG(I).eq.'B') go to 190
         TEMPL = 1000.*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATOUL(I) = WATOUL(I)+TEMPL
         SEDOUL(I) = SEDOUL(I)+TEMPL*SEDCOL(I)
         go to 220
190      continue
         TEMPL = (WATVOL(I)/VOLG(I))*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATOUL(I) = WATOUL(I)+TEMPL
         go to 220
200      continue
         if (TYPEG(J).eq.'B') go to 210
         TEMPL = 1000.*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATOUL(J) = WATOUL(J)+TEMPL
         SEDOUL(J) = SEDOUL(J)+TEMPL*SEDCOL(J)
         go to 220
210      continue
         TEMPL = (WATVOL(J)/VOLG(J))*DSPG(K,NDAT)*XSTURG(K)/CHARLG(K)
         WATOUL(J) = WATOUL(J)+TEMPL
220   continue
5000  format (1X,'System definition warning:  The dispersive pairs',' in
     &clude an internal'/1X,'mixing of segment ',I4,'.  This',' pair has
     & been ignored.')
5010  format (1X,'System definition warning:  Dispersive pairing',' numb
     &er',I5/1X,'refers to a segment that is not part of',' this ecosyst
     &em.'/1X,'This specification has been ignored.')
5020  format (1X,'System definition warning:  dispersive pairing ','numb
     &er',I5/1X,'contains a zero as a parameter value.'/1X,'This specifi
     &cation has been ignored.')
      return
      end
