head 2.9; access ; symbols ; locks ; strict; comment @c @; 2.9 date 98.08.24.13.45.57; author bobh; state Exp; branches ; next 2.8; 2.8 date 98.03.17.11.11.43; author bobh; state Exp; branches ; next 2.7; 2.7 date 97.09.09.09.52.49; author bobh; state Exp; branches ; next ; desc @Calibration program for ATLAS temperature pods @ 2.9 log @Archiving sources after M2/M3 & Eqpac deployments of 1998 @ text @ program calsh6(filename) character*80 filename c c program to compute steinhart-hart equation coefficients by least c squares fit to (r,t) data in (resistance,degrees centigrade). c c programmed by jim holbrook, aug 75. c n = number of data points c--modifed to run on either old-style temp boards or newer self c--calibrating boards. Will check for flag after sensor number c--If ieng = blank or 0, will assume old style board. c--If ieng = 1, will assume new style board. c--Should be able to mix and match boards... c--This will replace CALSH4 and CALENG c--jan 91, ljm C c Ported to HP-UX running on hp9000/850 - rah, 20mar91 c Modified to also run HP SST pods, rah, 07aug92 c dimension nc(20),res(20,20) dimension teng(20,20),ieng(20),neng(20),line(20) real*8 r(20),t(20),rr,tt,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10 real*8 a,b,c,aa,bb,cc,reng(20) character*20 labx,laby character*40 labt character*9 idate character*1 itype common/scales/xmin,xmax,xdel,ymin,ymax,ydel common/sizes/xx,yy,xnum,xlab,xdash,xsym common/types/ntype,nax,nsym common/labels/nlabx,nlaby,nlabt,labx,laby,labt data xx,yy,xnum,xlab,xsym,xdash /7.,5.,.112,.14,2*.07/ data nlabx,nlaby,labx,laby /15,13,'Temperature (C)', 1 'Residuals (C)'/ data nlabt,labt/33,'Thermistor Calibration: '/ c i = index(filename,' ') if (i.le.1) then type *, 'Syntax: calsh5 filename' stop endif call date(idate) labt(25:33)=idate filename(i:i+3) = '.dat' open(unit=1,file=filename,status='old') 100 read (1,*) ntherm,ntemp,ihx filename(i:i+3) = '.out' open(unit=6,file=filename,status='unknown') filename(i:i+3) = '.tbl' open(unit=16,file=filename,form='formatted',status='unknown') filename(i:i+4) = '.coef' open(unit=2,file=filename,status='unknown') 921 continue iflg=0 c--read in bath temps read (1,*) (t(k),k=1,ntemp) ymax1 = 0.0 ymin1=0.0 c c--for each sensor, calculate coeff do 998 ns = 1,ntherm i=0 r1=0.d0 r2=r1 r3=r1 r4=r1 r5=r1 r6=r1 r7=r1 r8=r1 45 format (2i5) read (1,45) line(ns),ieng(ns) write (6,106) line(ns) 106 format (//10x,'Thermistor Calibration of - ',I5// 110x,'Steinhart-Hart Equation Fit') if (ihx.EQ.1) read (1,5) (nc(i),i=1,ntemp) if (ihx.ne.1) read (1,6) (nc(i),i=1,ntemp) 5 format (20z5) 6 format (20i6) if (ieng(ns).eq.0) then write (6,606) 606 format (/,10x,'Old-Style Board',/, 1 10x,' R = 7.68E+08/(2.525*N - 7680)',/) else if (ieng(ns).eq.1) then iflg=1 read (1,5) (neng(i),i=1,ntemp) write (6,607) 607 format (/,10x,'Self-Calibrating Board',/, 1 10x,' R = 3.072E+08/N',/) else if (ieng(ns).eq.2) then iflg=2 write (6,608) 608 format (/,10x,'HP SST Board',/, 1 10x,' R = 4.0E+08/N',/) endif do 925 i=1,ntemp if (ihx.ne.2) then if (ieng(ns).eq.1) then r(i)=3.072e+08/nc(i) reng(i)=3.072e+08/neng(i) else if (ieng(ns).eq.0) then r(i)=7.68e+08/(2.525*nc(i)-7680.) else r(i)=4.0e+08/nc(i) reng(i)=4.0e+08/neng(i) endif else r(i)=nc(i) endif rr=r(i) tt=t(i) rr=dlog10(rr) tt=1.0/(tt+273.15) r1=r1+rr r2=r2+rr**2 r3=r3+rr**3 r4=r4+rr**4 r5=r5+rr**6 r6=r6+tt r7=r7+tt*rr r8=r8+tt*rr**3 925 continue c 900 r9=ntemp r10=r9*(r2*r5-r4*r4)-r1*(r1*r5-r4*r3) +r3*(r1*r4-r2*r3) if (r10.ne.0.0d0) go to 931 write (6,933) 933 format (//10x,'det = 0, no coefficients') go to 921 931 a=r6*(r2*r5-r4*r4)-r1*(r7*r5-r4*r8)+r3*(r7*r4-r2*r8) a=a/r10 b=r9*(r7*r5-r4*r8)-r6*(r1*r5-r4*r3)+r3*(r1*r8-r3*r7) b=b/r10 c=r9*(r2*r8-r7*r4)-r1*(r1*r8-r3*r7)+r6*(r1*r4-r2*r3) c=c/r10 aa=a bb=b cc=c write (6,102) aa,bb,cc 102 format (//10x,'A = ',e14.7/10x,'B = ',e14.7/ 2 10x,'C = ',e14.7) c c save coef. on unit 2 c write (2,825) line(ns),idate,aa,bb,cc 825 format(i5,3x,a,3e15.7) c if (ieng(ns).ne.1) then write (6,103) 103 format (///20x,' R T T(R) RESIDUAL'/) else write (6,603) 603 format (///22X, 1' R T T(R) RESIDUAL N(ENG) T(ENG)'/) endif tsum=0.0 tmin=0.0 tmax=0.0 do 800 i=1,ntemp rs=dlog10(r(i)) tr=a+b*rs+c*rs**3 tr=1.0/tr-273.15 td=t(i)-tr trr=tr if (ieng(ns).eq.1) then rs=dlog10(reng(i)) tr=a+b*rs+c*rs**3 teng(i,ns)=1.0/tr-273.15 write (6,604) nc(i),nc(i),r(i),t(i),trr,td,neng(i) 1 ,teng(i,ns) 604 format (3x,z5,1x,i6,4x,f12.5,3f10.4,3x,z5,f10.4) else write (6,104) nc(i),nc(i),r(i),t(i),trr,td 104 format (3x,z5,1x,i6,4x,f12.5,3f10.4) endif if (td.lt.tmin) tmin=td if (td.gt.tmax) tmax=td tsum=tsum+td*td res(i,ns) = td 800 continue c type *,tmin,tmax tsum=sqrt(tsum/(ntemp-3)) amax=amax1(tmax,abs(tmin)) write (6,105) amax,tsum 105 format (///10x,'Maximum Residual = ',f8.4 1 /10x,'Standard Error = ',f8.4) c c Write out Linda's table of information for this sensor c if (ns .eq. 1) write (16,1050) idate 1050 format (1h1/// 1 25x,' ATLAS'/ 1 25x,'TEMPERATURE CALIBRATIONS'/ 1 25X,'------------------------'// 1 4X,'Date:', a9,' Counts/Resist/Temp Conv:'// 1 4x,'Observers:___________ R = '// 1 4x,'Calibration Program: calsh5 T = '// 1 4x,'Temperature Range:__________________ '// 1 4x,'-------------------------------------------------------'// 1 4x,'Comments regarding calibration:'/ 1 4x,'(procedure changes,new standard, software changes, etc)'// 1 ////// 1 4x,'------------------------------------------------------'// 1 4x,' ',5x,' A ',6x,' B ',6x,' C ',5x,'Max ', 1 1x,'Std '/ 1 4x,' Sensor',5x,'*E-02',6x,'*E-03',6x,'*E-05',5x,'Resid ', 1 1x,'Error Comments'/) c if (ieng(ns).eq.1) then write (16,1052) line(ns),aa/1.e-2,bb/1.e-3,cc/1.e-5, 1 amax,tsum else write (16,1051) line(ns),aa/1.e-2,bb/1.e-3,cc/1.e-5, 1 amax,tsum endif 1051 format (4x,x,i5,x,3f11.7,2f9.4) 1052 format (3x,'S',x,i5,x,3f11.7,2f9.4) c if (tmin.lt.ymin1) ymin1 = tmin if (tmax.gt.ymax1) ymax1 = tmax 998 continue c c--write out eng cable data if available if (iflg.ne.1) go to 996 write (16,456) (t(i),i=1,ntemp) 456 format (//, 1'------------------------------------------------------'// 24x,'Self-Calibrating Board Summary:',//,4x,'Sensor ',10f6.2,/) c do 995 i=1,ntherm if (ieng(i).eq.1) 1 write (16,457) line(i),(teng(j,i),j=1,ntemp) 457 format (5x,i5,x,20f6.2) 995 continue 996 close(16) c type *,ymin1,ymax1 999 close(unit=2) c write (6,1000) 1000 format('1') stop end @ 2.8 log @Archiving sources prior to porting to DOS/Windows @ text @@ 2.7 log @Archiving various changes @ text @@