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