C ------------------------------------------------------------------------------
C * ПРОГРАММА РАСЧЕТА РАВНОВЕСНОГО СОСТАВА РАСТВОРОВ «RRSU»	*
C ------------------------------------------------------------------------------
	DIMENSION RP (40, 99), СО (10, 99), V (40, 10), CONST (40)
	READ (5, 1) LO, N NS
C * LO — ЧИСЛО ВАРИАНТОВ, N — ЧИСЛО БАЗИСНЫХ ЧАСТИЦ, NS — ОБЩЕЕ ЧИСЛО ЧАСТИЦ
1	FORMAT (20I4)
	WRITE (6, 100) LO, N, NS
100	FORMAT ('РАСЧЕТ РАВНОВЕСНОГО СОСТАВА РАСТВОРОВ ПО ПРОГРАММЕ',
 *	'«RRSU»', //T 20, ИСХОДНЫЕ ДАННЫЕ', /'ВАРИАНТОВ-',I3,
 *	'БАЗИСНЫХ ЧАСТИЦ-',I3,', ОБЩЕЕ ЧИСЛО ЧАСТИЦ —', I3)
	IF (LO .LE. 99 .AND. N .LE. 10 .AND. NS .LE. 40) GOTO 102
	WRITE (6, 101)
101	FORMAT ('ПРЕВЫШЕНА РАЗМЕРНОСТЬ ЗАДАНИЯ, ДОЛЖНО БЫТЬ:'/,
 *	' LO<=99, N< =10, NS<=40)
	GOTO 25
102	WRITE (6,60)
60	FORMAT(/2X, 'N', 4X, 'LOG К', 7X, 'СТЕХИОМЕТРИЧЕСКИЕ КОЭФФИЦИЕНТЫ'//)
	DO 2 I = 1, NS
		IF (I .GT. N) GOTO 11
		CONST(I)=0.
		DO 12 J = l, N
			V(I,J)=0.
			IF(I .EQ. J)VQ, J)=l.
12		CONTINUE
		GOTO 13
11		READ (5, 3) CONST (I), (V(I, J), J=1, N)
13		WRITE (6, 4) I, CONST (I), (V(I, J), J=1, N)
2	CONTINUE
C * CONST — LOG КОНСТАНТ РАВНОВЕСИЯ, V — СТЕХИОМЕТРИЧЕСКИЕ КОЭФФИЦИЕНТЫ
C * НЕФОРМАЛЬНЫХ РЕАКЦИЙ
3	FORMAT (F8.3, 10F4.2)
4	FORMAT (I4,') ', F7.3, 10F5.1)
	WRITE (6,6)
6	FORMAT (//' N BAP.', 10X, 'ОБЩИЕ КОНЦЕНТРАЦИИ БАЗИСНЫХ ЧАСТИЦ'//)
	DO 203 J=l, LO
	READ (5, 5) (CO(I, J), I=1, N)
	WRITE (6, 7) J,(CO(I, J), I=1, N)
203	CONTINUE
C * CO — ОБЩИЕ КОНЦЕНТРАЦИИ БАЗИСНЫХ ЧАСТИЦ
5	FORMAT (10E8.3)
7	FORMAT (I3,')', 1P10E11.3)
	DO 51 L = l, LO
		DO 51 J = l, NS
			RP(J, L)=0.
51	CONTINUE
	CALL BASISU (RP, СО, V, CONST, N, NS, LO, IER, L)
	IF (IER .EQ. 0) GOTO 20
	WRITE (6, 4I) L, IER
41	FORMAT ('АВАРИЙНЫЙ ОСТАНОВ В ПРОГРАММЕ «BASISU»'/
 *	'ВАРИАНТ N', I3,', ПАРАМЕТР ОШИБКИ IER=', I2)
20	WRITE (6,21)
21	FORMAT (//, T20, 'РЕЗУЛЬТАТЫ РАСЧЕТА'//' N ВАР. ',
 *	Т10, 'РАВНОВЕСНЫЕ КОНЦЕНТРАЦИИ ПРОДУКТОВ РЕАКЦИЙ'/)
	DO 22 I = 1, LO
		WRITE (6, 23) I, (RP(J, I), J=l, NS)
22	CONTINUE
23	FORMAT (", 12, ') ', 1P10E11.3,/(4X, 1P10E11.3))
25	STOP
	END

C ------------------------------------------------------------------------------
SUBROUTINE BASISU (RP, COl, VI, CONST1, N, NS, LO, IER, L)
C ------------------------------------------------------------------------------
C ПОДПРОГРАММА РАСЧЕТА РАВНОВЕСНОГО СОСТАВА РАСТВОРОВ МЕТОДОМ БРИНКЛИ	*
C ------------------------------------------------------------------------------
	DIMENSION RC (10), СО (10), COl (10, 99), V (40, 10),VI (40, 10),
 *	CONST (40), RP (40, 99), G (10), DG (55), RM (40), CONST1 (1)
	COMMON /BAS/ V, CO, CONST
C ------------------------------------------------------------------------------
C RP - КОНЦЕНТРАЦИИ ПРОДУКТОВ РЕАКЦИЙ, COl — ОБЩИЕ КОНЦЕНТРАЦИИ ЧАСТИЦ	*
C РАВНОВЕСИЯ, N — ЧИСЛО БАЗИСНЫХ ЧАСТИЦ, NS - ОБЩЕЕ ЧИСЛО ЧАСТИЦ,	*
C LO — ЧИСЛО ВАРИАНТОВ РАСЧЕТА, 1ER ПАРАМЕТР ОШИБКИ, L HOMI-P ВАРИАНТА,	*
C РАССЧИТАННОГО С ОШИБКОЙ	*
C ------------------------------------------------------------------------------
	L=1
	EPSO= 1.Е — 6
30	DO 200 I = 1, N
		СО(I) = C01(I, L)
		DO 200 J = 1, NS
			V(J,I) = VI(J, 1)
200	CONTINUE
	DO 201 I = 1, NS
201		CONST(I)=CONST1(I)*2.3026
	LF = 1
C * ПЕРЕХОД НА ОПТИМИЗАЦИЮ БАЗИСА
	CALL OPTIMUM(N, NS)
C * ЗАДАНИЕ НАЧАЛЬНЫХ ЗНАЧЕНИЙ КОНЦЕНТРАЦИЙ БАЗИСНЫХ ЧАСТИЦ
	DO 401 I=1, N
		DO 402 J=1, NS
			IF(V(J,I) .NE. 1.) GOTO 402
			DO 403 II=1, N
				IF(I .EQ. II) GOTO 403
				IF(V(J, II) .NE. 0.) GOTO 402
403			CONTINUE
			A=l.E-7
			IF(CO(I) .GT. 0.) A=CO(I)
			RC(I)=ALOG(A)
			GOTO 401
402		CONTINUE
401	CONTINUE
C * РАСЧЕТ КОНЦЕНТРАЦИЙ ПРОДУКТОВ РЕАКЦИЙ
19	DO 1 J=1, NS
		SUM1=0.
		DO 2 J = l, N
2			SUM1 =SUM1 +V(I,J)*RC(J)
1	RP(I, L)=EXP(CONST(I)+SUM1)
	GMAX=0.
C * РАСЧЕТ НЕВЯЗОК(G) МАТЕРИАЛЬНЫХ БАЛАНСОВ И ИХ ПРОИЗВОДНЫХ
C * (DG) ПО RC
	K=0
	DO 3 J=l, N
		SUM = 0.
		DO 4 I = 1, NS
			RM(I)=V(I,J) * RP(I, L)
4		SUM=SUM+RM(I)
		GJ=CO(J)
		G(J)=SUM1-GL
		GJ=ABS(G(J))
		IF(GJ .GT. GMAX) GMAX=GJ
		DO 5 JA=1, J
			SUM=0.
			DO 6 I = 1, NS
				GJ=V(I,JA)
				SUM = SUM + RM(I)*GJ
6			CONTINUE
			K=K+1
5			DG(K)=SUM
3		CONTINUE
C «РАСЧЕТ ПОПРАВОК К RC МЕТОДОМ НЬЮТОНА
		CALL SINV(DG, N, 1.E-5, IER)
		CALL MPRD(DG, G, RM, N, N, 1, 0, 1)
C * АНАЛИЗ НА ОКОНЧАНИЕ РАСЧЕТА
		SUM=0.
		DO 7 I = 1, N
			IF(ABS(RM(I)) .GT. SUM) SUM = ABS(RM(I))
7		CONTINUE
		IF(SUM .LT. EPSO) GOTO 17
		IF(LF .GT. 50) GOTO 12
C * РАСЧЕТ НОВЫХ ЗНАЧЕНИЙ RC
		DO 8 I = 1, N
			A = 1.
			IF(ABS(RM(I)) .GT. 1.) A=l./ABS(RM(I))
			RC(I) = RC(I)-A * RM(I)
8		CONTINUE
		LF=LF+1
		GOTO 19
C * АНАЛИЗ ТИПА ОШИБКИ
	IF(GMAX .LT. 1.E—4) GOTO 14
	IER=2
	GOTO 22
13	IF(SUM .LE. 1E-3) GOTO 17
	IER=1
	GOTO 22
C * ПЕРЕХОД НА РАСЧЕТ НОВОГО ВАРИАНТА
14	CONTINUE
	L=L+1
	IF(L .LE. LO) GOTO 30
22	RETURN
	END
C ------------------------------------------------------------------------------
	SUBROUTINE OPTIMUM(N, NS)
C ------------------------------------------------------------------------------
C ПРОГРАММА ОПТИМИЗАЦИИ БАЗИСА *
C ------------------------------------------------------------------------------
	DIMENSION V(40, 10), СО(10), CONST(40), VS(10)
	COMMON /BAS/V, CO, CONST, VS
C * ПРЕОБРАЗОВАНИЕ В БАЗИС С НЕОТРИЦАТЕЛЬНЫМИ ОБЩИМИ КОНЦЕНТРАЦИЯМИ
12	DO 1 I=1,N
		IF(CO(I).LT.0.)GOTO 10
1	CONTINUE
	GOTO 13
10	K=I
	DO 2 J=1,NS
		IF(V(J,I).LT.0.)GOTO 11
2	CONTINUE
	WRITE(6,50)I
50	FORMAT('АВАРИЙНЫЙ ОСТАНОВ В ПОДПРОГРАММЕ OPTIMUM',/
 * 	'ОШИБКА В ИСХОДНЫХ ДАННЫХ.'/,
 *	'В СТОЛБЦЕ', I3,'МАТРИЦЫ СТЕХИОМЕТРИЧЕСКИХ КОЭФФИЦИЕНТОВ',/
 *	'НЕТ ОТРИЦАТЕЛЬНЫХ ВЕЛИЧИН'/
	STOP
11	MFL=1
С * ЗАМЕНА БАЗИСНОЙ ЧАСТИЦЫ
14	B=V(J,K)
	BB=CONST(J)
	DO 3 I=1,N
		VS(I)=V(J,I)
3	CONTINUE
	CALL SMENA(B,BB,K,N,NS)
	IF(MFL.EQ.1)GOTO 12
13	KFL=0
C * ПРЕОБРАЗОВАНИЕ В БАЗИС С МИНИМАЛЬНОЙ СУММОЙ LOG K
	DO 4 J=1,NS
		IF(CONST(J).LE.0.)GOTO 4
		Q=1.E10
		DO 5 I=1,N
			IF(V(J,I).LE.0.)GOTO 5
			IF(CO(I).EQ.0.)GOTO 5
			B=CO(I)/V(J,I)
			IF(Q.LT.B)GOTO 5
			Q=B
			K=I
			KFL=1
			MFL=2
5    	CONTINUE
		IF(KFL.NE.0)GOTO 14
4	CONTINUE
	RETURN
	END
C ------------------------------------------------------------------------------
      SUBROUTINE SMENA (B,BB,K,N,NS)
C ------------------------------------------------------------------------------
C ПОДПРОГРАММА ЗАМЕНЫ БАЗИСНОЙ ЧАСТИЦЫ И ПЕРЕСЧЕТА ОБЩИХ	*
C КОНЦЕНТРАЦИЙ И КОНСТАНТ РАВНОВЕСИЯ *
C ------------------------------------------------------------------------------
	DIMENSION V(40,10),CO(10),CONST(40),VS(10)
	COMMON /BAS/ V,CO,CONST,VS
C * ПЕРЕСЧЕТ СТЕХИОМЕТРИЧЕСКИХ КОЭФФИЦИЕНТОВ И КОНСТАНТ РАВНОВЕСИЯ 
	I=1
11	Q=V(I,K)
	IF(Q.EQ.0.) GOTO 10
	DO 1 J=1,N
		V(I,J)=V(I,J)-Q*V(J)/B
		IF(ABS(V(I,J)).LT.1.E-5) V(I,J)=0
1	CONTINUE
	V(I,K)=Q/B
	CONST(I)=CONST(I)-Q*BB/B
	IF(ABS(CONST(I)).LT.1.E-5)CONST(I)=0.
10	I=I+1
	IF(I.LE.NS)GOTO 11
C * ПЕРЕСЧЕТ ОБЩИХ КОНЦЕНТРАЦИЙ
	Q=CO(K)
	DO 2 J=1,N
	 CO(J)=CO(J)-Q*VS(J)/B
2 CONTINUE
	CO(K)=Q/B
	RETURN
	END
