c http://Evgenii.Rudnyi.Ru/ c SUBROUTINE SETKCL1(Full) IMPLICIT DOUBLE PRECISION (A-H, O-Z) double precision mav DOUBLE PRECISION CS(5), CL(5), CM(5), CD(5) C Full = .True. all exp., Full = .False. recommended exp. LOGICAL Full COMMON /HSC/ HMELT, TMELT, CS, CL, CM, CD CHARACTER LINE*80, DIMT*2, DIMP*2, NAME*25, CLUE*2 C NEXT - # of the last experiment on total pressure C NT - # of the last point for total pressure C NEXEF - # of the last experiment on Knudsen effusion C NEF - # of the last point for Knudsen effusion C NEXTR - # of the last experiment on transpiration C NTR - # of the last point for transpiration C NEXK5 - # of the last experiment on K5 measurement C NK5 - # of the last point for K5 C NAME(I)- name of i-th experiment C NP(I) - number of points in i-th experiment C NFP(I) - # of the first point for the i-th experiment C T(I) - temperature in K C P(I) = ln{[p(mon) + p(dim)]/atm} for total pressure C = ln [p(eff KE)/atm] = ln {[flow]*sqrt[2*pi*RT/M(mon)]} C for Knudsen effusion C = ln [p(eff TR)/atm] = ln [p(sys)/(1 + n(c.g.)*M(mon)/m] C for transpiration C = ln [p(dim)/p(mon)] for K5 LOGICAL EQ COMMON /DAT/ NEXT, NT, NEXTR, NTR, NEXEF, NEF, NEXK5, NK5, * NAME(40), NP(40), NFP(40), T(600), P(600), P1(600), EQ(40) COMMON /KCL/ AMKCL DO i = 1, 40 EQ(i) = .FALSE. END DO HMELT = 26320. TMELT = 1044. AMKCL = 74.5513 C flow(g/sm^2/s) = p(atm)*PTOM C 0.1 from kg/(m*m*s) to g/(sm*sm*s) PTOM = 0.1d0*SQRT(AMKCL*1d-3/2.d0/3.14159d0/8.31441d0)*101325.d0 OPEN (1, NAME='KCL.CP', STATUS='OLD') READ (1,'()') READ (1, *) CS READ (1,'()') READ (1, *) CL READ (1,'()') READ (1, *) CM READ (1,'()') READ (1, *) CD CLOSE (1) OPEN (1, NAME='KCLTOTAL.DAT', STATUS='OLD') I = 1 NUM = 1 2 FORMAT(A) DO 3 READ (1, 2, END=10) LINE IF (LINE(1:16).NE.'Knudsen effusion') THEN IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).NE.' ') THEN IF (Line(1:1) .EQ. '*') THEN READ (1, 2, END=10) LINE ELSE IF (.NOT. Full) THEN DO WHILE (Line(1:5) .NE. ' ') READ (1, 2, END=10) LINE END DO GO TO 3 END IF READ (LINE, *) NAME(I), CLUE IF (CLUE .NE. 'eq') THEN DO READ (1, 2, END=10) LINE IF (LINE(1:1).NE.';') THEN READ (LINE, *) DIMT, DIMP IF (DIMT.EQ.'C ') THEN ADDT = 273.15 ELSE ADDT = 0. END IF IF (DIMP.EQ.'Pa') THEN CPR = 101325. ELSE IF (DIMP.EQ.'mm') THEN CPR = 760. ELSE CPR = 1. END IF GO TO 7 END IF END DO 7 NFP(I) = NUM NP(I) = 0 DO READ (1, 2, END=9) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') THEN GO TO 9 ELSE READ (LINE, *) T(NUM), P(NUM) T(NUM) = T(NUM) + ADDT P(NUM) = LOG(P(NUM) / CPR) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END IF END DO ELSE DO EQ(I) = .TRUE. READ (1, 2, END=10) LINE IF (LINE(1:1).NE.';') THEN READ (LINE, *) NP(I), TMIN, TMAX, A, B, C NFP(I) = NUM DO J = NUM, NUM + NP(I) - 1 TEMP = TMIN + (TMAX - TMIN) * (J - NUM) * / (NP(I) - 1) T(J) = TEMP P(J) = -A/TEMP + B - C*LOG(TEMP) END DO NUM = NUM + NP(I) GO TO 9 END IF END DO ENDIF 9 IF (NP(I).GT.0) I = I + 1 END IF END IF ELSE GO TO 10 END IF END DO 10 NEXT = I - 1 NT = NUM - 1 DO 11 READ (1, 2, END=20) LINE IF (LINE(1:13) .EQ. 'Transpiration') GO TO 20 IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).NE.' ') THEN IF (Line(1:1) .EQ. '*') THEN READ (1, 2, END=10) LINE ELSE IF (.NOT. Full) THEN DO WHILE (Line(1:5) .NE. ' ') READ (1, 2, END=10) LINE END DO GO TO 11 END IF READ (LINE, *) NAME(I), CLUE NFP(I) = NUM NP(I) = 0 IF (CLUE.NE.'tw') THEN DO READ (1, 2, END=18) LINE IF (LINE(1:1).NE.';') THEN READ (LINE, *) DIMT, DIMP IF (DIMT.EQ.'C ') THEN ADDT = 273.15 ELSE ADDT = 0. END IF IF (DIMP .EQ. 'Pa') THEN CPR = 101325. ELSE IF (DIMP .EQ. 'mm') THEN CPR = 760. ELSE IF (DIMP .EQ. 'g/') THEN DO READ (1, 2, END=18) LINE IF (LINE(1:1) .NE. ';') THEN C read area READ (LINE, *) CPR GO TO 14 END IF END DO C 1/mm^2 * 100 * g*10^9/s * 10^(-9) -> g/sm^2/s 14 CPR = 1./(1./CPR * 1e-7/PTOM) ELSE IF (DIMP .EQ. 'mg') THEN C mg/sm^2/min *0.001/60 -> g/sm^2/s CPR = 1./(0.001/60/PTOM) ELSE CPR = 1. END IF GO TO 16 END IF END DO 16 DO READ (1, 2, END=18) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') THEN GO TO 18 ELSE READ (LINE, *) T(NUM), P(NUM) IF (DIMT .EQ. 'in') T(NUM) = 1000./T(NUM) IF (DIMP .EQ. 'lg') P(NUM) = 10.**(P(NUM))/760. T(NUM) = T(NUM) + ADDT P(NUM) = LOG(P(NUM)/CPR) IF (DIMP .EQ. 'mg' .OR. DIMP .EQ. 'g/') * P(NUM) = P(NUM) + 0.5*LOG(T(NUM)) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END IF END DO ELSE DO READ (1, 2, END=18) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') THEN GO TO 18 ELSE READ (LINE, *) T(NUM), P(NUM), A2 C ptot = p(assume only mon) * (1 + sqrt(2) a) / (1 + 2 a) P(NUM) = P(NUM) * (1. + 2.*A2)/(1. + SQRT(2.d0)*A2) P(NUM) = LOG(P(NUM)/760.) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END IF END DO END IF 18 IF (NP(I).GT.0) I = I + 1 END IF END IF END DO 20 NEXEF = I - 1 NEF = NUM - 1 DO 21 READ (1, 2, END=30) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).NE.' ') THEN IF (Line(1:1) .EQ. '*') THEN READ (1, 2, END=10) LINE ELSE IF (.NOT. Full) THEN DO WHILE (Line(1:5) .NE. ' ') READ (1, 2, END=10) LINE END DO GO TO 21 END IF READ (LINE, *) NAME(I), CLUE NFP(I) = NUM NP(I) = 0 IF (CLUE.EQ.'1') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), P(NUM) P(NUM) = LOG(P(NUM)/760.) P1(NUM) = 1. NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ELSE IF (CLUE .EQ. '5') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), V, AN2, AKCL, P(NUM) T(NUM) = T(NUM) + 273.15 C psys = peff*(nc*Mmono/m + 1) P1(NUM) = (P(NUM) * (AN2 / AKCl + 1.))/760. P(NUM) = LOG(P(NUM)/760.) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ELSE IF (CLUE .EQ. 'al') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), V, AN2, AKCL, P(NUM), P1(NUM) P1(NUM) = P1(NUM)/760. P(NUM) = LOG(P(NUM)/760.) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ELSE IF (CLUE .EQ. 'Ma') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), V, AN2, AKCLT, AKCLD, * MAV, PTOT, P1(NUM) P1(NUM) = P1(NUM)/760. C peff = psys/(nc*Mmon/m + 1) P(NUM) = LOG(P1(NUM)/(AN2*AMKCL/(AKCLT-AKCLD) + 1)) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ELSE IF (CLUE .EQ. 'M') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), AV, PTOT P1(NUM) = 1. C m/nc = Mav/(psys/ptot - 1) AMNC = AV/(760./PTOT - 1) C peff = psys/(nc*Mmon/m + 1) P(NUM) = LOG(1./(AMKCL/AMNC + 1)) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ELSE IF (CLUE .EQ. 'Me') THEN DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN READ (LINE, *) A, B, C GO TO 26 END IF END DO 26 DO READ (1, 2, END=28) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') GO TO 28 READ (LINE, *) T(NUM), AV PTOT = EXP(-A/T(NUM) + B - C*LOG(T(NUM))) P1(NUM) = 1. C m/nc = Mav/(psys/ptot - 1) AMNC = AV/(1./PTOT - 1) C peff = psys/(nc*Mmon/m + 1) P(NUM) = LOG(1./(AMKCL/AMNC + 1)) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END DO ENDIF 28 IF (NP(I).GT.0) I = I + 1 END IF END IF END DO 30 NEXTR = I - 1 NTR = NUM - 1 GO TO 999 DO READ (1, 2, END=40) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).NE.' ') THEN READ (LINE, *) NAME(I) NFP(I) = NUM NP(I) = 0 DO READ (1, 2, END=42) LINE IF (LINE(1:1).NE.';') THEN IF (LINE(1:5).EQ.' ') THEN GO TO 42 ELSE READ (LINE, *) T(NUM), P(NUM) P(NUM) = LOG(P(NUM)*SQRT(2.d0)) NUM = NUM + 1 NP(I) = NP(I) + 1 END IF END IF END DO 42 IF (NP(I).GT.0) I = I + 1 END IF END IF END DO 40 NEXK5 = I - 1 NK5 = NUM - 1 999 CLOSE (1) RETURN END SUBROUTINE HSCOR (TF, DH1, DS1, DH2, DS2) IMPLICIT DOUBLE PRECISION (A-H, O-Z) DIMENSION CS(5), CL(5), CM(5), CD(5) COMMON /HSC/ HMELT, TMELT, CS, CL, CM, CD SMELT=HMELT/TMELT T1=TMELT*1E-4 T=TF*1E-4 IF (T.LT.T1) GO TO 5 IF (T.GT.T1) GO TO 10 DH1=0. DS1=0. DH2=0. DS2=0. RETURN 5 DH1=1E4*( (CM(1)-CS(1))*(T-T1) - (CM(2)-CS(2))*(1./T-1./T1) + * (CM(3)-CS(3))/2.*(T**2-T1**2) + (CM(4)-CS(4))/3.*(T**3-T1**3) + * (CM(5)-CS(5))*0.25*(T**4-T1**4) ) DS1=(CM(1)-CS(1))*LOG(T/T1) - * (CM(2)-CS(2))*0.5*(1./T**2-1./T1**2) + * (CM(3)-CS(3))*(T-T1) + (CM(4)-CS(4))/2.*(T**2-T1**2) + * (CM(5)-CS(5))/3.*(T**3-T1**3) DH2=1E4*( (CD(1)-2.*CS(1))*(T-T1) - * (CD(2)-2.*CS(2))*(1./T-1./T1) + * (CD(3)-2.*CS(3))/2.*(T**2-T1**2) + * (CD(4)-2.*CS(4))/3.*(T**3-T1**3) + * (CD(5)-2.*CS(5))*0.25*(T**4-T1**4) ) DS2=(CD(1)-2.*CS(1))*LOG(T/T1) - * (CD(2)-2.*CS(2))*0.5*(1./T**2-1./T1**2) + * (CD(3)-2.*CS(3))*(T-T1) + (CD(4)-2.*CS(4))/2.*(T**2-T1**2) + * (CD(5)-2.*CS(5))/3.*(T**3-T1**3) DH2 = DH2 - DH1 DS2 = DS2 - DS1 RETURN 10 DH1=1E4*( (CM(1)-CL(1))*(T-T1) - (CM(2)-CL(2))*(1./T-1./T1) + * (CM(3)-CL(3))/2.*(T**2-T1**2) + (CM(4)-CL(4))/3.*(T**3-T1**3) + * (CM(5)-CL(5))*0.25*(T**4-T1**4) ) - HMELT DS1=(CM(1)-CL(1))*LOG(T/T1) - * (CM(2)-CL(2))*0.5*(1./T**2-1./T1**2) + * (CM(3)-CL(3))*(T-T1) + (CM(4)-CL(4))/2.*(T**2-T1**2) + * (CM(5)-CL(5))/3.*(T**3-T1**3) - SMELT DH2=1E4*( (CD(1)-2.*CL(1))*(T-T1) - * (CD(2)-2.*CL(2))*(1./T-1./T1) + * (CD(3)-2.*CL(3))/2.*(T**2-T1**2) + * (CD(4)-2.*CL(4))/3.*(T**3-T1**3) + * (CD(5)-2.*CL(5))*0.25*(T**4-T1**4) ) - 2.*HMELT DS2=(CD(1)-2.*CL(1))*LOG(T/T1) - * (CD(2)-2.*CL(2))*0.5*(1./T**2-1./T1**2) + * (CD(3)-2.*CL(3))*(T-T1) + (CD(4)-2.*CL(4))/2.*(T**2-T1**2) + * (CD(5)-2.*CL(5))/3.*(T**3-T1**3) -2.*SMELT DH2 = DH2 - DH1 DS2 = DS2 - DS1 RETURN END