      subroutine STEADY(Y)
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      include 'LOCAL3.INC'
      dimension Y(KOUNT,KCHEM)
      double precision Y
      real YSAV(NPX,NCHEM), MOLTST
      double precision PRODLD
      integer JJJ(NPX)
      real CHECK, FACTR, RELERR, SATST, TEST, TOTDRF
      double precision INTLDL
      integer I, ICRIT, II, J, JJ, K, KK, K2
      real LKOUNT
      NDAT = MONTHG
      do 100 J = 1, KOUNT
         JJJ(J) = 0
100   continue
      RELERR = 1.E-5
110   continue
      do 130 K2 = 1, KCHEM
         do 120 J = 1, KOUNT
            YSAV(J,K2) = 0.0
            Y(J,K2) = 0.0D+00
120      continue
130   continue
      LKOUNT = 0.0
140   continue
      LKOUNT = LKOUNT+1.0
      if (LKOUNT.gt.100000.) go to 190
      ICRIT = 1
      do 180 K2 = 1, KCHEM
         do 170 J = 1, KOUNT
            PRODLD = 0.0D+00
            do 150 I = 1, KCHEM
               PRODLD = PRODLD+YIELDL(K2,I,J)*Y(J,I)
150         continue
            INTLDL = 0.0D+00
            do 160 I = 1, KOUNT
               INTLDL = INTLDL+INTINL(I,J,K2)*Y(I,K2)
160         continue
            Y(J,K2) = (CONLDL(J,K2)+INTLDL+PRODLD)/TOTKL(J,K2)
            if (Y(J,K2).ne.0.) TEST = 1.-YSAV(J,K2)/Y(J,K2)
            if (TEST.gt.RELERR) ICRIT = 0
            YSAV(J,K2) = Y(J,K2)
170      continue
180   continue
      if (ICRIT.eq.1) go to 200
      go to 140
190   continue
      write (TTYOUT(MACHNO),5000)
      IFLAG = 8
      go to 330
5000  format (/1X,'Steady-state concentrations cannot be computed for','
     & this ecosystem.'/1X,'Try a system that includes an export',' flow
     &.')
200   continue
      do 260 K2 = 1, KCHEM
         MOLTST = 0.01*MWTG(K2)
         do 260 J = 1, KOUNT
            II = -3
            do 250 I = 1, 7
               II = II+1
               if (SPFLGG(I,K2).eq.0) go to 250
               SATST = ALPHA(3*I+II,J,K2)*Y(J,K2)
               CHECK = 0.50*YSATL(I,J,K2)
               if (I.eq.1.and.CHECK.gt.MOLTST) CHECK = MOLTST
               if (SATST.le.CHECK) go to 250
               FACTR = SATST/CHECK
               FACTR = FACTR*1.15
               write (TTYOUT(MACHNO),5010) J
5010  format (/1X,'Solubility criteria exceeded in system segment ',I3,'
     &.')
               TOTDRF = 0.
               do 220 KK = 1, KCHEM
                  do 210 JJ = 1, KOUNT
                     TOTDRF = TOTDRF+DRFLDG(JJ,KK,NDAT)
210               continue
220            continue
               if (TOTDRF.eq.0.) go to 320
               do 240 KK = 1, KCHEM
                  SYSLDL(KK) = 0.
                  do 230 JJ = 1, KOUNT
                     DRFLDG(JJ,KK,NDAT) = DRFLDG(JJ,KK,NDAT)/FACTR
                     TOTLDL(JJ,KK) = SEELDG(JJ,KK,NDAT)+STRLDG(JJ,KK,
     &                  NDAT)+NPSLDG(JJ,KK,NDAT)+PCPLDG(JJ,KK,NDAT)+
     &                  DRFLDG(JJ,KK,NDAT)
                     CONLDL(JJ,KK) = 1.0D+06*TOTLDL(JJ,KK)/WATVOL(JJ)
                     SYSLDL(KK) = SYSLDL(KK)+TOTLDL(JJ,KK)
230               continue
240            continue
               write (TTYOUT(MACHNO),5020) FACTR
5020  format (/1X,'Drift loads have been reduced by a factor of ',      
     &1PG11.4/)
               JJJ(J) = JJJ(J)+1
               if (JJJ(J).le.5) go to 110
               write (TTYOUT(MACHNO),5030)
5030           format (/1X,'However, this does not seem to be working:')
               go to 320
250         continue
260   continue
      do 280 K = 1, KCHEM
         do 270 J = 1, KOUNT
            CONLDL(J,K) = 0.0D+00
270      continue
280   continue
      do 310 K = 1, KCHEM
         TRANLD(K) = 0.0
         do 300 J = 1, KOUNT
            do 290 I = 1, KCHEM
               TRANLD(K) = TRANLD(K)+YIELDL(K,I,J)*Y(J,I)*WATVOL(J)
290         continue
300      continue
         TRANLD(K) = TRANLD(K)*1.E-06
310   continue
      go to 330
320   continue
      IFLAG = 8
      write (TTYOUT(MACHNO),5040)
5040  format (/3X,'Solubility criteria exceeded, cause not apparent.'/3X
     &   ,'Please reduce loads and try again.')
330   continue
      return
      end
