PROGRAM MSD C programma peredelana dlya Lahey FORTRAN CHARACTER DIR*4 WRITE (*,190) GO TO 5 1 WRITE (*,200) 5 WRITE (*,210) READ (*,220) DIR IF (DIR.EQ.'inf ') GO TO 1 IF (DIR.NE.'kon ') GO TO 10 STOP 10 IF (DIR.NE.'vvi ') GO TO 15 CALL WWI GO TO 5 15 IF (DIR.NE.'vki ') GO TO 20 CALL WKI GO TO 5 20 IF (DIR.NE.'pso ') GO TO 25 CALL PSO GO TO 5 25 IF (DIR.NE.'vkr ') GO TO 30 CALL WKR GO TO 5 30 IF (DIR.NE.'ras ') GO TO 5 CALL RAS GO TO 5 190 FORMAT 1(/10X,'Evgenii Rudnyi - prosessing Mass Spectrometry Data, 1993', 1//,10X,'This program is very old - I wrote it a long time ago.', 1//,20X,'I am sorry for unconvenience.', 1//,10X,'Have you prepared the data file? If not type kon.', 1//,10X,'Type inf all the time to get some more information.',//) 200 FORMAT(10X,'programma obrabotki mass-spektral''nykh', 1 'dannykh - msd' 1 ,//,25X,'est'' direktivy',//, 1 10X,'vvi - vvod-vyvod ionnykh tokov',/, 1 10X,'vki - vychislenie konstanty ionnykh tokov',/, 1 10X,'pso - pervichnaya statisticheskaya obrabotka',/, 1 10X,'vkr - vychislenie konstant ravnovesiya',/, 1 10X,'ras - raschet ental''pii reaktsii po II i III zakonu',/, 1 10X,'inf - poluchenie etoi informatsii',/, 1 10X,'kon - vykhod iz programmy',//) 210 FORMAT(1X,4Hmsd>) 220 FORMAT(A3) END SUBROUTINE WKI CHARACTER DIR*4 C C vychislenie konstanty ionnykh tokov - iz massivov t(NSUM) i C ION(NSUM,NION) vychislyaet massivy TN(NSUMN) i KP(NSUMN) po C zadannomu uravneniyu. tochki s nulevymi ionnymi tokami vybrasyvayut C C est' direktivy C for - formirovanie raschetnogo uravneniya C ras - raschet konstant ionnykh tokov C REAL ION,KP COMMON /WWI1/ NSUM,NION,T(80),ION(80,15) COMMON /WKI1/ NSUMN,TN(80),KP(80),N,NOM(80) C C OP(25) - nomera ionov C oPE(25) - operatsii nad ionami C INTEGER OP(25) CHARACTER*1 OPE(25) C C usTroistvo vvoda vyvoda - displei C GO TO 5 1 WRITE (*,200) 5 WRITE (*,210) C C vvod direktivy C READ (*,220) DIR C C esli nazhata klavisha v pervoi pozitsii - vozvrat C IF (DIR.EQ.'inf ') GO TO 1 IF (DIR.EQ.' ') RETURN IF (DIR.NE.'for ') GO TO 45 C C direktiva formirovaniya raschetnogo uravneniya C 6 WRITE (*,230) READ (*,240,ERR=20) (OP(I),OPE(I),I=1,25) NOP=0 C C NOP - chislo ionov v konstante C C vychislenie chisla operandov C DO 10 I=1,25 IF (OP(I).LT.1.OR.OP(I).GT.NION) GO TO 15 10 NOP=I 15 IF (NOP.GT.0) GO TO 25 20 WRITE (*,250) GO TO 5 25 IF (NOP.GT.1) GO TO 30 WRITE (*,260) OP(1) GO TO 5 C C proverka operatsii C 30 DO 35 I=1,NOP-1 35 IF(OPE(I).NE.'*'.AND.OPE(I).NE.'/')GO TO 20 C C vyvod sformirovannogo uravneniya C WRITE (*,265) DO 40 I=1,NOP WRITE (*,270) OP(I) IF (I.EQ.NOP) GO TO 44 40 WRITE (*,280) OPE(I) 44 WRITE (*,290) GO TO 5 45 IF (DIR.NE.'ras ') GO TO 5 C C direktiva provedeniya rascheta C esli uravnenie ne sformirovano, to vypolnyaetsya for C C IK - nomer tekushchei tochki, v obshchem sluchae mozhet otlichat'sya ot C I - nomerA tochki v iskhodnom massive, tak kak proiskhodit vybros C tochki v kotoroi odin iz nuzhnykh ionnykh tokov raven nulyu C IF (OP(1).EQ.0) GO TO 6 IK=0 NSUMN=NSUM DO 55 I=1,NSUM IK=IK+1 DO 50 J=1,NOP IF (ION(I,OP(J)).NE.0) GO TO 46 IK=IK-1 NSUMN=NSUMN-1 WRITE (*,300) I,OP(J) GO TO 55 46 IF (J.GT.1) GO TO 47 TN(IK)=T(I) KP(IK)=ION(I,OP(J)) GO TO 50 47 IF (OPE(J-1).EQ.'*') KP(IK)=KP(IK)*ION(I,OP(J)) IF (OPE(J-1).EQ.'/') KP(IK)=KP(IK)/ION(I,OP(J)) 50 CONTINUE KP(IK)=ALOG(KP(IK)) 55 CONTINUE GO TO 25 200 FORMAT(10X,'podprogramma vychislenie konstanty ionnykh', 1 'tokov - vki' 1 ,//,25X,'est'' direktivy',//, 1 10X,'for - formirovanie raschetnogo uravneniya',/, 1 25X,'naprimer 3,*1,/2',//, 1 10X,'eto oznachaet, chto tretii ionnyi tok neobkhodimo',/, 1 10X,'umnozhit'' na pervyi i razdelit'' na vtoroi',/, 1 15X,'probely nezhelatel''ny, zapyatye obyazatel''ny',//, 1 10X,'ras - provedenie vychislenii',/, 1 10X,'inf - poluchenie etoi informatsii',/, 1 10X,'- vykhod iz podprogrammy',//) 210 FORMAT(1X,4Hvki>) 220 FORMAT(A3) 230 FORMAT(1X,'uravnenie rascheta ') 240 FORMAT(25(I4,A1)) 250 FORMAT(20X,'poprobuite eshche raz',//) 260 FORMAT(//,1X,'kI=I(',I2,') pravil''no?') 265 FORMAT(//,1X,'KI=') 270 FORMAT('&I(',I2,')') 280 FORMAT('&',A1) 290 FORMAT('& pravil''no?') 300 FORMAT(1X,'tochka N ',I2,' vybroshena, ionnyi tok N ',I2,'=0') END SUBROUTINE PSO CHARACTER DIR*4 C C pervichnaya statisticheskaya obrabotka - pso C iz massivov TN(NSUMN) i KR(NSUMN) vnachale formiruetsya matritsa C usredneniya i zatem soglasno nei rasschityvayutsya dannye pervichnoi C statisticheskoi obrabotki C C est' direktivy C fom - formirovanie massiva usredneniya NOM(NSUMN) C vym - vyvod massiva usredneniya C ism - ispravlenie massiva usredneniya C usr - provedenie rascheta soglasno massivu usredneniya C vvo - vvod massivov TPR(NN), KPR(NN), SI(NN), NI(NN) C s klaviatury displeya C vyv - vyvod massiva dannykh na ekran displeya C isp - ispravleniya massiva dannykh C CHARACTER*1 CHO INTEGER SUMNI REAL KP, KPR, KPRF COMMON /WKI1/ NSUMN,TN(80),KP(80),N,NOM(80) COMMON /PSO1/ SP,NN,TPR(80),KPR(80),KPRF(80),SI(80),NI(80), 1 SUMNI C usTroistvo vvoda vyvoda - displei C GO TO 5 1 WRITE (*,200) 5 WRITE (*,210) C C vvod direktivy C READ (*,220) DIR C C esli nazhata klavisha v pervoi pozitsii - vozvrat C IF (DIR.EQ.'inf ') GO TO 1 IF (DIR.EQ.' ') RETURN IF (DIR.NE.'fom ') GO TO 60 C C direktiva formirovaniya massiva usredneniya C proverka zapolneny li massivy TN i KP C IF (NSUMN.GT.0) GO TO 6 WRITE (*,230) GO TO 5 6 N=1 NI(1)=1 NOM(1)=1 C C nachalo osnovnogo tsikla po vsem tochkam C DO 55 L=2,NSUMN C C nachalo tsikla sravneniya s predydushchimi tochkami C DO 45 I=1,N C C nakhozhdenie nuzhnoi temperatury C DO 15 J=1,NSUMN IF(NOM(J).NE.I) GO TO 15 TMIN=TN(J) GO TO 20 15 CONTINUE 20 IF (TN(L).GE.TMIN) GO TO 35 C C tekushchaya temperatura men'she I-oi predydushchei C NOM(L)=I DO 25 K=1,L-1 25 IF (NOM(K).GE.I) NOM(K)=NOM(K)+1 DO 30 K=N+1,I+1,-1 30 NI(K)=NI(K-1) NI(I)=1 GO TO 50 35 IF (TN(L).GT.TMIN) GO TO 40 C C tekushchaya temperatura L ravnyaetsya I-oi predydushchei C NI(I)=NI(I)+1 NOM(L)=I GO TO 55 40 IF (I.LT.N) GO TO 45 C C tekushchaya tochka L bol'she, chem poslednyaya N-aya C NI(N+1)=1 NOM(L)=N+1 GO TO 50 C C konets tsikla sravneniya s predydushchimi tochkami C 45 CONTINUE 50 N=N+1 C C konets osnovnogo tsikla C 55 CONTINUE NN=N GO TO 5 60 IF (DIR.NE.'vym ') GO TO 85 C C direktiva vyvoda matritsy usredneniya C WRITE (*,240) DO 80 I=1,N DO 65 J=1,NSUMN IF(NOM(J).NE.I) GO TO 65 WRITE (*,250) I,TN(J),NI(I) GO TO 70 65 CONTINUE 70 DO 75 J=1,NSUMN 75 IF(NOM(J).EQ.I) WRITE(*,260) KP(J),J WRITE (*,260) 80 CONTINUE GO TO 5 85 IF (DIR.NE.'ism ') GO TO 115 C C direktiva ispravleniya massiva usredneniya C vybor rezhima C WRITE (*,270) 90 READ (*,280) CHO IF (CHO.EQ.'v') GO TO 95 IF (CHO.EQ.'r') GO TO 100 GO TO 90 C C vybros tochki C 95 WRITE (*,290) READ (*,300,ERR=95)NUMBER IF (NUMBER.LT.1.OR.NUMBER.GT.NSUMN) GO TO 5 IF (NOM(NUMBER).EQ.0) GO TO 95 C C nel'zya vybrosit' tochku, esli ona odna pri temperature C IF (NI(NOM(NUMBER)).EQ.1) GO TO 95 NI(NOM(NUMBER))=NI(NOM(NUMBER))-1 NOM(NUMBER)=0 GO TO 95 C C rezhim razdeleniya temperatury C 100 WRITE (*,310) READ (*,300,ERR=100) NUMBER IF (NUMBER.LT.1.OR.NUMBER.GT.N) GO TO 5 101 WRITE (*,320) READ (*,300,ERR=101) NUMB IF (NUMB.GE.NI(NUMBER)) GO TO 100 N=N+1 NN=N DO 105 I=N,NUMBER+2,-1 IF(N.EQ.NUMBER+1) GO TO 106 105 NI(I)=NI(I-1) 106 NI(NUMBER+1)=NI(NUMBER)-NUMB NI(NUMBER)=NUMB J=0 DO 110 I=1,NSUMN IF (NOM(I).LE.NUMBER) GO TO 111 NOM(I)=NOM(I)+1 GO TO 110 111 IF (NOM(I).LT.NUMBER) GO TO 110 J=J+1 IF (J.LE.NUMB) GO TO 110 NOM(I)=NOM(I)+1 110 CONTINUE GO TO 100 115 IF (DIR.NE.'usr ') GO TO 130 IF (N.GT.0) GO TO 116 WRITE (*,330) GO TO 5 116 SUMNI=0 SP=0 DO 125 I=1,N KPR(I)=0. SI(I)=0. DO 120 J=1,NSUMN IF (NOM(J).NE.I) GO TO 120 TPR(I)=TN(J) KPR(I)=KPR(I)+KP(J) SI(I)=SI(I)+KP(J)**2 120 CONTINUE KPR(I)=KPR(I)/FLOAT(NI(I)) IF (NI(I).GT.1) GO TO 122 SI(I)=0. GO TO 123 122 SI(I)=ABS(SI(I)-KPR(I)**2*FLOAT(NI(I))) SP=SP+SI(I) SI(I)=SQRT(SI(I)/FLOAT(NI(I)-1)) 123 SUMNI=SUMNI+NI(I) 125 CONTINUE IF(SUMNI.EQ.NN)GOTO 5 SP=SQRT(SP/FLOAT(SUMNI-N)) GO TO 5 130 IF (DIR.NE.'vvo ') GO TO 140 C C direktiva vvoda dannykh s terminala C 131 WRITE (*,340) READ (*,300,ERR=131) NN DO 135 I=1,NN 132 WRITE (*,350) I READ (*,360,ERR=132) TPR(I),KPR(I),SI(I),NI(I) IF (TPR(I).LE.0.) GO TO 5 C C po umolchaniya NI(I)=0 C 135 IF (NI(I).EQ.0) NI(I)=1 136 SUMNI=0 SP=0. DO 137 I=1,NN SUMNI=SUMNI+NI(I) 137 SP=SP+SI(I)**2*(NI(I)-1) IF(SUMNI.EQ.NN)GOTO 5 SP=SQRT(SP/FLOAT(SUMNI-NN)) GO TO 5 140 IF (DIR.NE.'vyv ') GO TO 150 C C direktiva vyvoda dannykh na ekran displeya C WRITE (*,370) DO 145 I=1,NN 145 WRITE (*,380) I,TPR(I),KPR(I),SI(I),NI(I) WRITE (*,385) SUMNI,SP GO TO 5 150 IF (DIR.NE.'isp ') GO TO 5 C C direktiva ispravleniya dannykh C vybor rezhima C 151 WRITE (*,310) READ (*,300,ERR=151) NUMBER IF (NUMBER.LT.1.OR.NUMBER.GT.NN) GO TO 136 WRITE (*,380) NUMBER,TPR(NUMBER),KPR(NUMBER),SI(NUMBER) 1 ,NI(NUMBER) 153 WRITE (*,390) READ (*,280) CHO IF (CHO.EQ.'i') GO TO 155 IF (CHO.EQ.'d') GO TO 165 IF (CHO.EQ.'z') GO TO 175 GO TO 153 C C rezhim isklyucheniya tochki C 155 NN=NN-1 DO 160 I=NUMBER,NN TPR(I)=TPR(I+1) KPR(I)=KPR(I+1) SI(I)=SI(I+1) 160 NI(I)=NI(I+1) GO TO 151 C C rezhim dobavleniya tochki C 165 NUMBER=NUMBER+1 NN=NN+1 DO 170 I=NN,NUMBER+1,-1 IF (NN.EQ.NUMBER) GO TO 175 TPR(I)=TPR(I-1) KPR(I)=KPR(I-1) SI(I)=SI(I-1) 170 NI(I)=NI(I-1) 175 WRITE (*,350) NUMBER READ (*,360,ERR=175) TPR(NUMBER),KPR(NUMBER), 1 SI(NUMBER),NI(NUMBER) IF (NI(NUMBER).EQ.0) NI(NUMBER)=1 GO TO 151 200 FORMAT(10X,'podprogramma pervichnoi statististicheskoi', 1 'obrabotki - pso' 1 ,//,25X,'est'' direktivy',//, 1 10X,'fom - formirovanie massiva usredneniniya',/, 1 10X,'vym - vyvod massiva usredneniya',/, 1 10X,'ism - ispravlenie v massive usredneniya',/, 1 10X,'usr - usrednenie dannykh soglasno massivu',/, 1 10X,'vvo - vvod dannykh s klaviatury displeya',/, 1 10X,'vyv - vyvod dannykh na ekran displeya',/, 1 10X,'isp - ispravleniya massiva dannykh',/, 1 10X,'inf - poluchenie etoi informatsii',/, 1 10X,'- vykhod iz podprogrammy',//) 210 FORMAT(1X,4Hpso>) 220 FORMAT(A3) 230 FORMAT(1X,'ne sformirovan massiv iskhodnykh temperatur i 1 konstant ravnovesiya') 240 FORMAT(4X,'t NI [LN(KI)-v skobkakh nomer tochki]') 250 FORMAT(1X,I2,F6.0,I3) 260 FORMAT('&',F7.2,:,'(',I2,')') 270 FORMAT('vybros tochki (v) ili razdelenie temperatury (r)? ') 280 FORMAT(A1) 290 FORMAT(1X,'nomer tochki dlya vybrosa? ') 300 FORMAT(I5) 310 FORMAT(1X,'nomer temperatury? ') 320 FORMAT(1X,'chislo tochek, kotorye ostayutsya? ') 330 FORMAT(1X,'ne sformirovana matritsa usredneniya') 340 FORMAT(1X,'chislo temperatur? ') 350 FORMAT('+','tochka N ',I2,' vvedite T, LN(KI), SI, NI',/) 360 FORMAT(3F10.0,I5) 370 FORMAT(4X,' T LN(KI) SI NI') 380 FORMAT(1X,I2,F6.0,F8.2,F6.2,I5) 385 FORMAT(//,1X,'obshchee chislo tochek=',I2,' SP=',F5.2) 390 FORMAT('isklyuchenie? (i), dobavlenie novoi? (d), zamena? (z) ') END SUBROUTINE WWI CHARACTER DIR*4 C C vvod-vyvod ionnykh tokov C C est' direktivy C fai - vyzov massiva dannykh (NSUM,NION,T(NSUM),ION(NSUM,NION)) C iz faila s imenem NAME(20) C vyv - vyvod massiva dannykh na ekran displeya C isp - ispravleniya massiva dannykh C REAL ION CHARACTER NAME*20,CHO*1 CHARACTER*8 EXPER,EXPER1 COMMON /WWI1/ NSUM,NION,T(80),ION(80,15) C C usTroistvo vvoda vyvoda - displei C GO TO 5 1 WRITE (*,100) 5 WRITE (*,110) C C vvod direktivy C READ (*,120) DIR C C esli nazhata klavisha v pervoi pozitsii - vozvrat C IF (DIR.EQ.'inf ') GO TO 1 IF (DIR.EQ.' ') RETURN IF (DIR.NE.'fai ') GO TO 90 C C direktiva vyzova dannykh iz faila C WRITE (*,130) READ (*,140) NAME DO 10 I=1,20 IF (NAME(I:I).NE.' ') GO TO 10 NAME(I:I+3)='.DAT' GO TO 15 10 CONTINUE 15 OPEN (UNIT=1, FILE=NAME, STATUS='OLD',ERR=5) WRITE (*,141) READ (*,142)EXPER 16 READ (1,142,END=18)EXPER1 IF(EXPER.NE.EXPER1)GOTO16 READ (1,160,ERR=18,END=18)NION NSUM=0 17 NSUM=NSUM+1 READ (1,*,ERR=18,END=18)T(NSUM),(ION(NSUM,J),J=1,NION) IF(T(NSUM).GT.0)GOTO17 18 NSUM=NSUM-1 CLOSE (UNIT=1) GO TO 5 90 IF (DIR.NE.'vyv ') GO TO 400 C C direktiva vyvoda na ekran displeya C WRITE (*,240) (I,I=1,NION) DO 95 I=1,NSUM 95 WRITE (*,250) I,T(I),(ION(I,J),J=1,NION) GO TO 5 400 IF (DIR.NE.'isp ') GO TO 5 C C direktiva ispravleniya tochki C NPOI - nomer tochki C 401 WRITE (*,260) READ (*,160,ERR=401) NPOI IF (NPOI.LT.1.OR.NPOI.GT.NSUM) GO TO 5 C C vybor rezhima - isklyuchenie, dobavlenie, zamena C WRITE (*,250) NPOI, T(NPOI),(ION(NPOI,J),J=1,NION) 405 WRITE (*,270) READ (*,145,ERR=405) CHO,MIN,MAX IF (CHO.EQ.'i') GO TO 410 IF (CHO.EQ.'d') GO TO 420 IF (CHO.EQ.'z') GO TO 430 GO TO 405 C C isklyuchenie tochki C 410 NSUM=NSUM-1 DO 415 I=NPOI,NSUM T(I)=T(I+1) DO 415 J=1,NION 415 ION(I,J)=ION(I+1,J) GO TO 401 C C dobavlenie tochki - nomer NPOI+1 C 420 NPOI=NPOI+1 NSUM=NSUM+1 C C obratnyi tsikl C DO 425 I=NSUM,NPOI+1,-1 IF (NPOI.EQ.NSUM) GO TO 426 T(I)=T(I-1) DO 425 J=1,NION 425 ION(I,J)=ION(I-1,J) 426 WRITE (*,230) NPOI,NION READ (*,200,ERR=426) T(NPOI),(ION(NPOI,J),J=1,NION) GO TO 401 C C zamena tochki C MIN=0,mAX=0 - polnaya zamena C MIN=0,MAX=-1 - zamena tol'ko temperatury C mIN=I,MAX=J - zamena ionov s I po J (temperatura I=0) C 430 IF (MIN.GT.0) GO TO 435 431 WRITE (*,280) READ (*,200,ERR=431) T(NPOI) 435 IF (MIN.LE.0) MIN=1 IF (MAX.LT.0) GO TO 5 IF (MAX.EQ.0) MAX=NION IF (MIN.GT.NION) MIN=1 IF (MAX.GT.NION) MAX=NION DO 440 I=MIN,MAX 439 WRITE (*,290) I 440 READ (*,200,ERR=439) ION(NPOI,I) GO TO 401 100 FORMAT(10X,'podprogramma vvod-vyvod ionnykh tokov - vvi' 1 ,//,25X,'est'' direktivy',//, 1 10X,'fai - vyzov massiva dannykh iz faila',/, 1 10X,'vyv - vyvod massiva dannykh na ekran displeya',/, 1 10X,'isp - ispravleniya massiva dannykh',/, 1 10X,'inf - poluchenie etoi informatsii',/, 1 10X,'- vykhod iz podprogrammy',//, 1 10X,'format of the data file is as follows',/, 1 10X,'A8 - experiment''s name',/, 1 10X,'I5 - number of ion currents',/, 1 10X,'T I1 ... In - temperature and ion currents',/, 1 10X,' ... ',/, 1 10X,'0 0 ... 0 - end of the experiment',//) 110 FORMAT(1X,4Hvvi>) 120 FORMAT(A3) 130 FORMAT(1X,'imya faila? ') 140 FORMAT(A) 141 FORMAT(1X,'imya eksperimenta? ') 142 FORMAT(A8) 145 FORMAT(A1,2I5) 160 FORMAT(I5) 200 FORMAT(20F8.0) 230 FORMAT(1X,'tochka N ',I2,', vvedite temperaturu i ',I2, 1 ' ionnykh tokov') 240 FORMAT(6X,1Ht,2X,8(:6H ion N,I1,2X):/10X,7(:5Hion N,I2,2X )) 250 FORMAT(I3,1X,F5.0,8F9.4,:,/,10X,7F9.4) 260 FORMAT(1X,'vvedite nomer tochki? ') 270 FORMAT 1 (1X,'isklyuchenie? (i), dobavlenie novoi? (d), zamena? (z) ') 280 FORMAT(1X,'novaya temperatura? ') 290 FORMAT(1X,'novyi ionnyi tok N ',I3,' ? ') END SUBROUTINE RAS INTEGER SUMNI REAL KPRF, KPR COMMON /PSO1/ SP,NN,TPR(80),KPR(80),KPRF(80),SI(80),NI(80), 1 SUMNI COMMON /WKR1/ R(5),HT(5),FT1(5),FT2(5),FT3(5),T1(5),T2(5) 1 ,T3(5) COMMON /RAS1/ H2,S2,TAV2,B2,SF2,H3,TAV3,B3,SF3 IF (NN.GT.0) GO TO 5 WRITE (*,200) RETURN 5 WRITE (*,210) READ (*,220,ERR=5) NUMBER IF (NUMBER.LT.0.OR.NUMBER.GT.5) RETURN IF (NN.NE.1) GO TO 10 H2=0. S2=0. TAV2=0. B2=1. SF2=0. GO TO 35 10 TAV2=0. DO 15 I=1,NN 15 TAV2=TAV2+1./TPR(I)*FLOAT(NI(I)) TAV2=TAV2/FLOAT(SUMNI) H2=0. S2=0. B2=0. DO 20 I=1,NN WORK=1./TPR(I)-TAV2 H2=H2+KPRF(I)*WORK*FLOAT(NI(I)) S2=S2+KPRF(I)*FLOAT(NI(I)) B2=B2+WORK**2*FLOAT(NI(I)) 20 CONTINUE H2=-H2/B2 B2=SQRT(B2) S2=S2/FLOAT(SUMNI)+H2*TAV2 TAV2=1./TAV2 SF2=0. IF (NN.EQ.2) GO TO 30 DO 25 I=1,NN 25 SF2=SF2+(KPRF(I)+H2/TPR(I)-S2)**2*FLOAT(NI(I)) SF2=SQRT(SF2/FLOAT(NN-2)) 30 H2=H2*R(NUMBER)/1000. S2=S2*R(NUMBER) DH=SF2/B2 DS=SQRT((DH/TAV2)**2+SF2**2/SUMNI)*R(NUMBER) DH=R(NUMBER)*DH/1000. WRITE (*,230) TAV2,H2,DH,S2,DS,B2,SF2,SP 35 H3=0. B3=0. DO 40 I=1,NN H3=H3+(FT(TPR(I),NUMBER)-R(NUMBER)*KPRF(I))/TPR(I)*FLOAT(NI(I)) B3=B3+1./TPR(I)**2*FLOAT(NI(I)) 40 CONTINUE H3=H3/B3 TAV3=1./TAV2*SUMNI/B3 SF3=0. IF (NN.EQ.1) GO TO 50 DO 45 I=1,NN 45 SF3=SF3+(KPRF(I)-(FT(TPR(I),NUMBER)-H3/TPR(I))/R(NUMBER))**2 1 *FLOAT(NI(I)) SF3=SQRT(SF3/FLOAT(NN-1)) 50 H3=H3/1000. B3=SQRT(B3) DH=R(NUMBER)*SF3/B3/1000. WRITE (*,240) NN,SUMNI WRITE (*,241) H3,DH,TAV3,B3,SF3 WRITE (*,250) DO 55 I=1,NN AK2=(S2-H2*1000./TPR(I))/R(NUMBER) DH=SF2*SQRT(1./FLOAT(SUMNI)+((1./TPR(I)-1./TAV2)/B2)**2) DS=AK2-KPRF(I) AK3=(FT(TPR(I),NUMBER)-H3*1000./TPR(I))/R(NUMBER) AH=(FT(TPR(I),NUMBER)-R(NUMBER)*KPRF(I))*TPR(I)/1000. 55 WRITE (*,260) I,TPR(I),KPRF(I),SI(I),NI(I),AK2,DH,DS,AK3,AH 200 FORMAT(1X,'ne sdelana pervichnaya statisticheskaya obrabotka') 210 FORMAT(1X,'nomer reaktsii? ') 220 FORMAT(I5) 230 FORMAT(1X,' TAV2=',F5.0,' H2=',F7.2,' DH=',F7.2,' S2=', 1 F7.2,' DS=',F7.2,//,' B2=',E10.3,' SF2=',F5.2,' SP=',F5.2) 240 FORMAT 1 (/1X,' chislo temperatur=',I2,' obshchee chislo tochek=',I3) 241 FORMAT(/,' H3=',F7.2,' DH=',F7.2,' TAV3=',F5.0,' B3=', 1 E10.3,' SF3=',F5.2) 250 FORMAT(/,6X,' T LNKP SI NI LNK2 DLNK2 ' 1 ,' LNK2-LNKP LNK3 H3') 260 FORMAT(I3,F7.0,F8.2,F6.2,I4,F9.2,2F8.2,F11.2,F8.2) RETURN END FUNCTION FT(TEMP,NUMBER) C C podprogramma ekstrapolyatsii DF C C esli T2=0 to FT=FT1 C esli t3=0 to FT approksimiruetsya liniei cherez FT1,T1;FT2,t2 C inache FT approksimiruetsya paraboloi cherez vse tri tochki C COMMON /WKR1/ R(5),HT(5),FT1(5),FT2(5),FT3(5),T1(5),T2(5) 1 ,T3(5) FT=FT1(NUMBER) IF (T1(NUMBER).EQ.0.) RETURN IF (T2(NUMBER).EQ.0.) RETURN WORK=(FT2(NUMBER)-FT1(NUMBER))/(T2(NUMBER)-T1(NUMBER)) FT=FT+(TEMP-T1(NUMBER))*WORK IF (T3(NUMBER).EQ.0.) RETURN WORK1=(FT3(NUMBER)-FT2(NUMBER))/(T3(NUMBER)-T2(NUMBER)) WORK=(WORK1-WORK)/(T3(NUMBER)-T1(NUMBER)) FT=FT+(TEMP-T1(NUMBER))*(TEMP-T2(NUMBER))*WORK RETURN END SUBROUTINE WKR CHARACTER DIR*4 C C vychislenie konstant ravnovesiya - vkr C vnachale vvodyatsya termodinamicheskie dannye o reaktsiyakh, C zatem formiruetsya raschetnoe uravnenie i posle etogo iz rezul'tat C pervichnoi statisticheskoi obrabotki KPR(NN) preobrazuetsya v KPRF( C C est' direktivy C vvt - vvod termodinamicheskikh dannykh reaktsii C vyt - vyvod termodinamicheskikh dannykh reaktsii C raf - raschet Df i KP C for - formirovanie raschetnogo uravneniya C ras - provedenie rascheta C vyv - vyvod massiva dannykh na ekran displeya C C EQ(80) - soderzhit tekst uravneniya C ore(5) - plyus ili minus LNKP C POW(5) - LNKP umnozhit' ili razdelit' C OPER - plyus ili minus konstanta C OPERA - vse uravnenie umnozhit' razdelit' C CHARACTER EQ*80,OPE(5)*1,POW(5)*1,OPER*1,OPERA*1 C C OP(5) - znacheniya nomerov KP C POWER(5) - znacheniya stepenei C AKONS - znachenie konstanty C STEP - znachenie obshchego mnozhitelya C INTEGER OP(5) DIMENSION POWER(5),ALK(5) INTEGER SUMNI REAL KPRF, KPR COMMON /PSO1/ SP,NN,TPR(80),KPR(80),KPRF(80),SI(80),NI(80), 1 SUMNI COMMON /WKR1/ R(5),HT(5),FT1(5),FT2(5),FT3(5),T1(5),T2(5) 1 ,T3(5) C C usTroistvo vvoda vyvoda - displei C DATA AKONS,STEP /0.,1./ OPER,OPERA /'+','*'/ GO TO 5 1 WRITE (*,200) 5 WRITE (*,210) C C vvod direktivy C READ (*,220) DIR C C esli nazhata klavisha v pervoi pozitsii - vozvrat C IF (DIR.EQ.'inf ') GO TO 1 IF (DIR.EQ.' ') RETURN IF (DIR.NE.'vvt ') GO TO 20 C C direktiva vvoda termodinamicheskikh dannykh reaktsii C 10 WRITE (*,230) READ (*,240,ERR=10) NUMBER IF (NUMBER.LT.1.OR.NUMBER.GT.5) GO TO 5 12 WRITE (*,250) C C po umolchaniyu R=8.31441 C READ (*,260,ERR=12) R(NUMBER) IF (R(NUMBER).EQ.0.) R(NUMBER)=8.31441 14 WRITE (*,270) READ (*,260,ERR=14) HT(NUMBER) 16 WRITE (*,280) READ (*,260,ERR=16) FT1(NUMBER),T1(NUMBER),FT2(NUMBER), 1 T2(NUMBER),FT3(NUMBER),T3(NUMBER) GO TO 10 20 IF (DIR.NE.'vyt ') GO TO 30 C C direktiva vyvoda termodinamicheskikh dannykh reaktsii C WRITE (*,290) (I,I,I=1,3) DO 25 I=1,5 IF (R(I).NE.0) WRITE(*,300) I,R(I),HT(I),FT1(I),T1(I), 1 FT2(I),T2(I),FT3(I),T3(I) 25 CONTINUE GO TO 5 30 IF (DIR.NE.'raf ') GO TO 40 C C direktiva rascheta Df i KP C 32 WRITE (*,230) READ (*,240,ERR=32) NUMBER IF (NUMBER.LT.1.OR.NUMBER.GT.5) GO TO 5 WRITE (*,290) WRITE (*,300)NUMBER,R(NUMBER),HT(NUMBER),FT1(NUMBER) 1 ,T1(NUMBER),FT2(NUMBER),T2(NUMBER),FT3(NUMBER), 1 T3(NUMBER) 34 WRITE (*,310) READ (*,260,ERR=34) TEMP IF (TEMP.LE.0) GO TO 32 FTT =FT(TEMP,NUMBER) ALK(1)=(FTT-HT(NUMBER)*1000./TEMP)/R(NUMBER) WRITE (*,320) FTT,ALK(1),EXP(ALK(1)) GO TO 34 40 IF (DIR.NE.'for ') GO TO 65 C C direktiva formirovaniya raschetnogo uravneniya - proiskhodit sintak- C sicheskii kontrol' eQ(80) i zapolnenie sootvetstvuyushchikh velichin C WRITE (*,330) READ (*,340) EQ 41 NOP=0 AKONS=0. STEP=1. OPER='+' OPERA='*' I=1 WRITE (*,360) C C levaya skobka ne neobkhodima C IF (EQ(I:I).NE.'(') GO TO 42 I=I+1 C C probel - okonchanie uravneniya C 42 IF (EQ(I:I).NE.' ') GO TO 44 WRITE (*,370) GO TO 5 C C zakrylas' pravaya skobka - nachalos' umnozhenie na chislo C 44 IF (EQ(I:I).EQ.')') GO TO 58 IF (EQ(I:I).EQ.'+'.OR.EQ(I:I).EQ.'-') GO TO 48 C C nepravil'nyi sintaksis C 46 NOP=0 WRITE (*,350) GO TO 5 C C pribavlenie KP ili konstanty C 48 IF (EQ(I+1:I+1).NE.'k') GO TO 54 NOP=NOP+1 OPE(NOP)=EQ(I:I) WRITE (*,380) OPE(NOP) I=I+2 IF (EQ(I:I).NE.'1'.AND.EQ(I:I).NE.'2'.AND.EQ(I:I).NE.'3' 1 .AND.EQ(I:I).NE.'4'.AND.EQ(I:I).NE.'5') GO TO 46 READ (EQ(I:I),240) OP(NOP) WRITE (*,390) EQ(I:I) I=I+1 C C vychislenie stepeni C IF (EQ(I:I).EQ.'*'.OR.EQ(I:I).EQ.'/') GO TO 50 POWER(NOP)=1 POW(NOP)='*' GO TO 42 50 POW(NOP)=EQ(I:I) WRITE (*,400) EQ(I:I) I=I+1 NUMBER=0 IF (EQ(I:I).NE.'.'.AND.EQ(I:I).NE.'1'.AND.EQ(I:I).NE.'2'.AND. 1 EQ(I:I).NE.'3'.AND.EQ(I:I).NE.'4'.AND.EQ(I:I).NE.'5'.AND. 1 EQ(I:I).NE.'6'.AND.EQ(I:I).NE.'7'.AND.EQ(I:I).NE.'8'.AND. 1 EQ(I:I).NE.'9'.AND.EQ(I:I).NE.'0') GO TO 46 52 NUMBER=NUMBER+1 I=I+1 IF (EQ(I:I).EQ.'.'.OR.EQ(I:I).EQ.'1'.OR.EQ(I:I).EQ.'2'.OR. 1 EQ(I:I).EQ.'3'.OR.EQ(I:I).EQ.'4'.OR.EQ(I:I).EQ.'5'.OR. 1 EQ(I:I).EQ.'6'.OR.EQ(I:I).EQ.'7'.OR.EQ(I:I).EQ.'8'.OR. 1 EQ(I:I).EQ.'9'.OR.EQ(I:I).EQ.'0') GO TO 52 READ (EQ(I-NUMBER:I-1),260) POWER(NOP) WRITE (*,405) EQ(I-NUMBER:I-1) GO TO 42 C C pribavlenie konstanty C 54 OPER=EQ(I:I) WRITE (*,400) OPER I=I+1 NUMBER=0 IF (EQ(I:I).NE.'.'.AND.EQ(I:I).NE.'1'.AND.EQ(I:I).NE.'2'.AND. 1 EQ(I:I).NE.'3'.AND.EQ(I:I).NE.'4'.AND.EQ(I:I).NE.'5'.AND. 1 EQ(I:I).NE.'6'.AND.EQ(I:I).NE.'7'.AND.EQ(I:I).NE.'8'.AND. 1 EQ(I:I).NE.'9'.AND.EQ(I:I).NE.'0') GO TO 46 56 NUMBER=NUMBER+1 I=I+1 IF (EQ(I:I).EQ.'.'.OR.EQ(I:I).EQ.'1'.OR.EQ(I:I).EQ.'2'.OR. 1 EQ(I:I).EQ.'3'.OR.EQ(I:I).EQ.'4'.OR.EQ(I:I).EQ.'5'.OR. 1 EQ(I:I).EQ.'6'.OR.EQ(I:I).EQ.'7'.OR.EQ(I:I).EQ.'8'.OR. 1 EQ(I:I).EQ.'9'.OR.EQ(I:I).EQ.'0') GO TO 56 READ (EQ(I-NUMBER:I-1),260) AKONS WRITE (*,405) EQ(I-NUMBER:I-1) GO TO 42 C C vychislenie postoyannoi na kotoruyu umnozhayut vse vyrazhenie C 58 WRITE (*,370) I=I+1 IF (EQ(I:I).NE.'/'.AND.EQ(I:I).NE.'*') GO TO 46 OPERA=EQ(I:I) WRITE (*,400) OPERA I=I+1 NUMBER=0 IF (EQ(I:I).NE.'.'.AND.EQ(I:I).NE.'1'.AND.EQ(I:I).NE.'2'.AND. 1 EQ(I:I).NE.'3'.AND.EQ(I:I).NE.'4'.AND.EQ(I:I).NE.'5'.AND. 1 EQ(I:I).NE.'6'.AND.EQ(I:I).NE.'7'.AND.EQ(I:I).NE.'8'.AND. 1 EQ(I:I).NE.'9'.AND.EQ(I:I).NE.'0') GO TO 46 60 NUMBER=NUMBER+1 I=I+1 IF (EQ(I:I).EQ.'.'.OR.EQ(I:I).EQ.'1'.OR.EQ(I:I).EQ.'2'.OR. 1 EQ(I:I).EQ.'3'.OR.EQ(I:I).EQ.'4'.OR.EQ(I:I).EQ.'5'.OR. 1 EQ(I:I).EQ.'6'.OR.EQ(I:I).EQ.'7'.OR.EQ(I:I).EQ.'8'.OR. 1 EQ(I:I).EQ.'9'.OR.EQ(I:I).EQ.'0') GO TO 60 READ (EQ(I-NUMBER:I-1),260) STEP WRITE (*,405) EQ(I-NUMBER:I-1) GO TO 5 65 IF (DIR.NE.'ras ') GO TO 90 C C direktiva provedeniya rascheta po sformirovannomu uravneniyu C po umolchaniyu KPRF=KPR C DO 70 I=1,NN 70 KPRF(I)=KPR(I) IF (NOP.EQ.0) GO TO 80 DO 75 I=1,NN DO 75 J=1,NOP ALK1=(FT(TPR(I),OP(J))-HT(OP(J))*1000./TPR(I))/R(OP(J)) IF (POW(J).EQ.'*') ALK1=ALK1*POWER(J) IF (POW(J).EQ.'/') ALK1=ALK1/POWER(J) IF (OPE(J).EQ.'+') KPRF(I)=KPRF(I)+ALK1 IF (OPE(J).EQ.'-') KPRF(I)=KPRF(I)-ALK1 75 CONTINUE 80 DO 85 I=1,NN IF (OPER.EQ.'+') KPRF(I)=KPRF(I)+AKONS IF (OPER.EQ.'-') KPRF(I)=KPRF(I)-AKONS IF (OPERA.EQ.'*') KPRF(I)=KPRF(I)*STEP IF (OPERA.EQ.'/') KPRF(I)=KPRF(I)/STEP 85 CONTINUE GO TO 41 90 IF (DIR.NE.'vyv ') GO TO 5 C C direktiva vyvoda C WRITE (*,410) IF (NOP.EQ.0) GO TO 91 WRITE (*,415) (OP(I),I=1,NOP) GO TO 92 91 WRITE (*,430) 92 DO 100 I=1,NN WRITE (*,420) I,TPR(I),KPR(I),SI(I),NI(I),KPRF(I) IF (NOP.GT.0) GO TO 94 WRITE (*,430) GO TO 99 94 DO 95 J=1,NOP 95 ALK(J)=(FT(TPR(I),OP(J))-HT(OP(J))*1000./TPR(I))/R(OP(J)) WRITE (*,425) 1 (ALK(J),J=1,NOP) 99 CONTINUE 100 CONTINUE GO TO 5 200 FORMAT(10X,'podprogramma vychislenie konstanty ravnove', 1 'siya - vkr' 1 ,//,25X,'est'' direktivy',//, 1 10X,'vvt - vvod termodinamicheskikh dannykh reaktsii',/, 1 10X,'vyt - vyvod termodinamicheskikh dannykh reaktsii',/, 1 10X,'raf - raschet Df i KP',/, 1 10X,'for - formirovanie raschetnogo uravneniya',/, 1 25X,'naprimer (+k3*2-k2/3+2.4)*0.5',/, 1 10X,'eto oznachaet',/, 1 10X,'LNKP=(LNKI+LNK(3)*2-LNK(2)/3+2.4)*0.5',/, 1 15X,'probely nedopustimy',//, 1 10X,'ras - provedenie vychislenii',/, 1 10X,'vyv - vyvod massiva dannykh na ekran displeya',/, 1 10X,'inf - poluchenie etoi informatsii',/, 1 10X,'- vykhod iz podprogrammy',////) 210 FORMAT(1X,4Hvkr>) 220 FORMAT(A3) 230 FORMAT(1X,'nomer reaktsii? ') 240 FORMAT(I5) 250 FORMAT(1X,'gazovaya postoyannaya? ') 260 FORMAT(6F10.0) 270 FORMAT(1X,'ental''piya? ') 280 FORMAT(1X,'ft1,t1,ft2,t2,ft3,t3? (dlya ekstrapolyatsii)',/) 290 FORMAT(7X,'R HT ',3(' FT',I1,' t',I1,3X)) 300 FORMAT(I4,F8.5,F8.2,3(F8.2,F6.0)) 310 FORMAT(1X,'T=') 320 FORMAT(1X,T15,' ft=',F7.2,' LNKP=',F6.2,' KP=',G10.3) 330 FORMAT(1X,'uravnenie rascheta ') 340 FORMAT(A) 350 FORMAT(//,1X,'poprobuite eshche raz') 360 FORMAT(//,1X,'LNKP=(LNKI') 370 FORMAT('&)') 380 FORMAT('&',A1,'LNK(') 390 FORMAT('&',A1,')') 400 FORMAT('&',A1) 405 FORMAT('&',A) 410 FORMAT(5X,' t LNKI SI NI LNKP ') 415 FORMAT('&',5(:'LNK(',I1,')')) 420 FORMAT(I3,F7.0,F7.2,F6.2,I4,F8.2) 425 FORMAT('&',5F8.2) 430 FORMAT('+') END