File: SPECHE.FT of Disk: Disks/MyPDP/m8-2-rka1-rkb1
(Source file text)
C MESSPROGRAMM COMMON X,T,R LOGICAL GOON REAL LN STEP =.25 CONST=1.E-09 DIMENSION T(50) DIMENSION R(50) DIMENSION ITAU(50) DIMENSION A(5) DIMENSION HEAT(50) WRITE(4,11900) READ(4,12000) SMASS WRITE(4,12100) READ(4,12000) ATMASS RATIO = ATMASS/SMASS WRITE(4,12200) READ(4,12000) RES WRITE(4,12300) READ(4,12400) IMFIT WRITE(4,12500) READ(4,12000) TSCALE WRITE(4,12600) READ(4,12700) GOON IF (.NOT.GOON) GOTO 5 6 WRITE(4,12800) READ(4,12400) IPOINT WRITE(4,12900) READ(4,12000) R(IPOINT) WRITE(4,503) R(IPOINT) 503 FORMAT(2X,E16.5) WRITE(4,13000) READ(4,12000) T(IPOINT) WRITE(4,503) T(IPOINT) 4 WRITE(4,13200) READ(4,12700) GOON IF (.NOT.GOON) GOTO 5 WRITE(4,13300) READ(4,12400) K WRITE(4,12900) READ(4,12000) R(K) WRITE(4,13000) READ(4,12000) T(K) GOTO 4 WRITE(4,35000) READ(4,12700) GOON IF(.NOT.GOON) GOTO 5 WRITE(4,12200) READ(4,12000) RES 5 IERR=100 IVAL=9999 IRANGE =1 MODE =2 K=1 TARGET =0 WRITE(4,36000) READ(4,12700) GOON IF (.NOT.GOON) GOTO 1005 INPUT=0 8 WRITE(4,37000) IOUT=DINP(1,1,IERRDI,INPUT) IF (IOUT.EQ.0) GOTO 8 OUT=SCINP(MODE,IRANGE,IERR,TARGET) MODE =1+8 IRANGE=0+4 CALL DVINP(MODE,IRANGE,IERR,IVAL) XZERO=OUT TIME =0 RT=FLOAT(IVAL) RR=RT GOTO 1001 1002 MODE =2 IRANGE=1 TARGET=XZERO+FLOAT(K)*STEP OUT=SCINP(MODE,IRANGE,IERR,TARGET) MODE =1+8 IRANGE=0+4 CALL DVINP(MODE,IRANGE,IERR,IVAL) XEFF=OUT+TARGET TIME=(XEFF-XZERO)*TSCALE RT=FLOAT(IVAL) 1001 WRITE(4,11800) K,TARGET,XEFF,TIME,RT WRITE(5,42000) IPOINT,K,RT,TIME K=K+1 ABKRIT=(RT-RO)/(RR-RO) C IF (ABKRIT-.2) 1003,1002,1002 IF (K-4) 1002,1003,1003 1003 ITAU(IPOINT)= K-1 WRITE(4,32000) READ(4,12000) HEAT(IPOINT) WRITE(4,34000) READ(4,12700) GOON IF(GOON) GOTO 6 1005 WRITE(4,33000) READ(4,12700) GOON IF (.NOT.GOON) GOTO 1010 C EVALUATION 1004 WRITE(4,40000) READ(4,12400) ICENT DO 500 J4=1,3 500 WRITE(4,501) R(J4),T(J4) 501 FORMAT(2X,2E15.4) CALL FITR(IMFIT,ICENT,R,T) RB = R(ICENT) CALL KELVIN(IMFIT,X,RB,TO) WRITE(4,505) TO 505 FORMAT(2X,E16.5) DO 110 I=1,5 110 A(I) = 0 112 CONTINUE 104 READ(5,42000) JO,J,RATT,TIME IHELP=JO-ICENT IF(IHELP) 104,105,108 105 CALL KELVIN(IMFIT,X,RATT,TAT1) WRITE(4,503) TO IF(J-0) 106,107,106 107 TR=TAT1 106 A(1)=A(1) +TIME DATT=TAT1-TO LN=ALOG(DATT) A(5)=A(5)+LN*LN A(2)=A(2)+TIME*TIME A(3)=A(3)+LN*TIME A(4)=A(4)+LN GOTO 112 108 IH=ICENT+1 DO 109 I1=IH,IPOINT DO 109 I2=1,ITAU(IH) 109 READ(5,42000) CONTINUE C CALCULATION OF TAU,A,B,DELTA ANZ= 1./FLOAT(J+1) DET=A(2)-A(1)*A(1)*ANZ TAU1=(A(3)-ANZ*A(1)*A(4))/DET DFIT=EXP(A(4)*ANZ-TAU1*A(1)*ANZ) B=A(3)-ANZ*A(1)*A(4) C=A(2)-A(1)*A(1)*ANZ D=A(5) - A(4)*A(4)*ANZ RQOU = B*B/(D*C) CO=CONST*HEAT(ICENT)*HEAT(ICENT)*RES/DELTA TAU=-1./TAU1 SPEC=TAU*CO*RATIO TEMP=(TO+TR)/2. C OUTPUT WRITE(4,2023) TEMP WRITE(4,2020) DELTA WRITE(4,2021) DFIT WRITE(4,2022) CO WRITE(4,2024) TAU WRITE(4,2025) RQOU WRITE(4,2026) SPEC WRITE(4,34000) READ(4,12700) GOON IF (GOON) GOTO 6 2023 FORMAT(/1X,30H MITTLERE TEMPERATUR = E14.4,' K') 2021 FORMAT(/1X,30H DELTA AUS FIT FUER TAU = E14.4,' K') 2025 FORMAT(/1X,30H STANDARTABWEICHUNG = E14.4) 2020 FORMAT(/1X,30H DELTA-T AUS TEM-FIT = E14.4,' K') 2022 FORMAT(/1X,30H THERMAL CONDUCTIVITY = E14.4,'W/K') 2024 FORMAT(/1X,30H TIME CONSTANT = E14.4,' SEC') 2026 FORMAT(/1X,30H SPECIFIC HEAT = E14.4,' J/(MOL*K)') 11800 FORMAT(2X,I3,4E16.6) 11900 FORMAT(/1X,'SAMPLE MASS:',T60,$) 12000 FORMAT(E16.6) 12100 FORMAT(/1X,'ATOM-MASS:',T60,$) 12200 FORMAT(/1X,'HEATERRESISTOR (KOHM) :',T60,$) 12300 FORMAT(/1X,'NUMBER OF TERMS:R-T EXPANSION:',T60,$) 12400 FORMAT(I3) 12500 FORMAT(/1X,'TIMEBASE-CONSTANT (SEC/VOLTS) :',T60,$) 12600 FORMAT(/1X,'POINT FOR R-T CALIBRATION:(T/F) :',T60,$) 12700 FORMAT(L1) 12800 FORMAT(/1X,'NUMBER OF POINT (I3) :',T60,$) 12900 FORMAT(/1X,'R (KOHM) =',T60,$) 13000 FORMAT(/1X,'T (K) =',T60,$) 13200 FORMAT(/1X,'CORRECTION OF POINT WANTED (T/F):',T60,$) 13300 FORMAT(/1X,'NUMBER FO POINT TO BE CORRECTED :(I3):',T60,$) 33000 FORMAT(/1X,'CALCULATION OF POINT (T/F)',T60,$) 40000 FORMAT(/1X,'NUMBER OF POINT TO BE CALCULATED :',T60,$) 42000 FORMAT(2X,2I5,2E16.6) 32000 FORMAT(/1X,'THE HEATERCURRENT WAS (MICROAMPS) :',T60,$) 34000 FORMAT(/1X,'ONE MORE MEASUREMENT OF A POINT? (T/F)',T60,$) 35000 FORMAT(/1X,'CHANGE OF RESISTORVALUE? (T/F):',T60,$) 36000 FORMAT(/1X,'RUN BEGINS (T/F) ',T60,$) 37000 FORMAT(1H+,T60,'') 38000 FORMAT(/1X,'END ??? (T/F)',T60,$) 1010 WRITE(4,38000) READ(4,12700) GOON IF(.NOT.GOON) GOTO 6 STOP END