PROGRAM CALIBRATE c subroutine CALIBRATE IMPLICIT NONE INTEGER I,J,K,L,Q,DIST(37,70),MAP(2,24),KKK,III REAL DCM(70,12),DMCM(24,2,12) INTEGER M,I2,L2,M2,BAD(3,100),NUMBADST REAL PEAKCAL(24,2,28,4),WIDTHCAL(24,2,28,4) REAL POS(2),IN1,IN2,SL1,SL2,MID REAL IN1_OLD,IN2_OLD,SL1_OLD,SL2_OLD,MID_OLD LOGICAL BDST DATA MAP /14,115,11,131,35,126,30,128,38,123,17,133, + 29,132,23,139,28,129,39,137,34,130,13,141, + 33,121,32,115,06,118,41,130,19,119,22,136, + 36,107,27,125,07,134,24,127,31,120,25,117/ DATA DIST /105,14,1,16,16,7,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,1,16,16,1,2,14,0,1,14,0,1,16,19,32,14,0,1, + 002,11,31,32,14,9,16,12,0,1,12,0,1,14,9,16,12,0,1, + 12,0,1,14,9,16,12,0,1,12,0,1,14,9,16,12,0,1, + 008,11,31,32,14,9,16,12,1,16,12,1,16,14,7,16,12,1,32, + 11,15,16,14,19,32,12,0,1,12,1,16,14,9,16,11,31,32, + 006,11,31,32,14,9,16,12,0,1,12,1,32,14,5,8,11,29,32, + 12,1,32,14,17,32,12,0,1,12,0,1,14,5,8,11,15,16, + 005,12,0,1,14,17,32,12,1,32,12,1,16,14,9,16,12,0,1, + 12,1,32,14,19,32,12,0,1,12,1,16,14,9,16,12,0,1, + 112,14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,13,15,16, + 14,1,32,16,1,2,14,1,32,14,1,32,16,9,16,14,0,1, + 107,13,15,16,16,19,32,14,0,1,14,0,1,16,9,16,13,31,32, + 14,0,1,16,17,32,14,1,16,13,31,32,16,19,32,14,0,1, + 007,12,0,1,14,1,2,12,1,16,12,0,1,14,17,32,12,0,1, + 12,0,1,14,17,32,12,1,32,12,1,32,14,19,32,11,15,16, + 108,14,0,1,16,17,32,14,0,1,14,1,32,16,9,16,13,31,32, + 13,31,32,16,9,16,14,0,1,14,1,32,16,17,32,14,1,32, + 009,11,31,32,14,15,32,12,0,1,12,1,16,14,9,16,12,0,1, + 12,0,1,14,1,2,12,1,16,12,1,16,14,17,32,12,0,1, + 106,13,31,32,16,9,16,14,1,32,14,0,1,16,9,16,14,0,1, + 14,0,1,16,17,32,14,1,32,14,1,32,16,9,16,13,31,32, + 109,13,15,16,16,19,32,14,1,16,14,0,1,16,9,16,13,15,16, + 14,0,1,16,9,16,13,15,16,14,1,32,16,17,32,14,0,1, + 014,12,0,1,14,1,2,12,0,1,12,0,1,14,17,32,12,0,1, + 12,0,1,14,15,32,12,0,1,12,0,1,14,17,32,12,0,1, + 116,13,31,32,16,5,8,13,31,32,14,0,1,16,9,16,13,31,32, + 13,15,16,16,9,16,14,0,1,14,1,32,16,17,32,14,0,1, + 117,14,0,1,16,9,16,14,0,1,14,1,32,16,17,32,14,0,1, + 13,31,32,16,17,32,14,0,1,14,1,32,16,17,32,14,0,1, + 012,12,0,1,14,9,16,11,31,32,12,0,1,14,17,32,11,31,32, + 12,0,1,14,17,32,11,31,32,12,0,1,14,17,32,12,0,1, + 015,12,0,1,14,17,32,12,0,1,12,0,1,14,9,16,12,0,1, + 12,0,1,14,9,16,11,31,32,12,0,1,14,9,16,11,15,16, + 018,12,0,1,14,1,2,12,0,1,12,0,1,14,9,16,11,31,32, + 12,0,1,14,1,2,12,1,32,12,0,1,14,9,16,12,0,1, + 118,13,31,32,16,9,16,14,1,32,14,0,1,16,9,16,14,0,1, + 14,0,1,16,1,2,14,1,32,14,0,1,16,17,32,14,0,1, + 119,14,0,1,16,9,16,14,0,1,13,31,32,16,9,16,14,0,1, + 14,0,1,16,9,16,14,1,32,14,0,1,16,9,16,14,0,1, + 111,13,31,32,16,17,32,14,0,1,13,31,32,16,9,16,14,0,1, + 14,0,1,16,17,32,14,1,32,14,0,1,16,9,16,14,0,1, + 013,12,0,1,14,17,32,12,0,1,12,1,32,14,1,2,12,1,32, + 11,15,16,14,9,16,12,0,1,12,0,1,14,17,32,12,0,1, + 011,12,0,1,14,17,32,12,0,1,11,31,32,14,9,16,11,31,32, + 11,31,32,14,1,2,12,1,16,12,1,32,14,17,32,12,1,16, + 021,12,0,1,14,17,32,12,1,32,11,31,32,14,17,32,12,0,1, + 12,0,1,14,9,16,12,0,1,12,0,1,14,1,2,12,1,32, + 017,11,31,32,14,9,16,12,1,32,12,0,1,14,17,32,11,31,32, + 11,31,32,14,9,16,12,0,1,12,1,32,14,1,2,12,0,1, + 120,13,31,32,16,9,16,14,0,1,14,0,1,16,17,32,14,0,1, + 13,31,32,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 025,12,0,1,14,17,32,11,31,32,12,0,1,14,9,16,12,0,1, + 11,31,32,14,17,32,12,0,1,12,0,1,14,9,16,12,0,1, + 024,12,0,1,14,9,16,11,31,32,11,31,32,14,19,32,11,31,32, + 12,0,1,14,17,32,11,31,32,12,0,1,14,9,16,12,0,1, + 114,13,31,32,16,17,32,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,1,32,14,0,1,16,9,16,14,0,1, + 115,13,31,32,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,17,32,14,1,32,14,0,1,16,1,2,14,0,1, + 121,14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,14,0,1, + 13,31,32,16,17,32,14,0,1,14,0,1,16,9,16,14,1,32, + 113,14,0,1,16,9,16,14,0,1,14,1,32,16,9,16,13,15,16, + 13,31,32,16,9,16,14,1,32,14,1,32,16,9,16,13,31,32, + 022,12,1,32,14,17,32,12,0,1,12,0,1,14,1,2,12,0,1, + 12,0,1,14,9,16,12,0,1,12,0,1,14,9,16,12,0,1, + 125,13,31,32,16,17,32,14,0,1,14,0,1,16,9,16,13,15,16, + 13,15,16,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 027,11,15,16,14,17,32,12,0,1,12,0,1,14,17,32,12,1,32, + 12,0,1,14,17,32,11,31,32,12,0,1,14,1,2,12,0,1, + 126,14,0,1,16,17,32,14,0,1,14,0,1,16,17,32,14,0,1, + 14,0,1,16,17,32,14,0,1,14,1,32,16,17,32,14,0,1, + 110,13,31,32,16,9,16,14,0,1,14,0,1,16,9,16,13,15,16, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 019,12,0,1,14,1,2,12,0,1,12,0,1,14,9,16,11,31,32, + 12,0,1,14,17,32,12,0,1,12,0,1,14,9,16,12,0,1, + 023,11,15,16,14,9,16,12,0,1,12,0,1,14,9,16,12,0,1, + 12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,12,0,1, + 026,11,31,32,14,17,32,11,31,32,12,0,1,14,9,16,12,0,1, + 11,31,32,14,17,32,12,0,1,11,31,32,14,9,16,12,0,1, + 029,12,0,1,14,17,32,12,0,1,11,31,32,14,9,16,12,0,1, + 12,0,1,14,17,32,12,0,1,12,1,32,14,17,32,12,0,1, + 129,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 13,31,32,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 031,12,0,1,14,9,16,12,0,1,12,0,1,14,9,16,12,0,1, + 12,0,1,14,9,16,12,0,1,12,0,1,14,9,16,11,31,32, + 032,12,0,1,14,1,2,12,0,1,11,31,32,14,9,16,11,31,32, + 12,0,1,14,1,2,12,0,1,11,31,32,14,17,32,12,1,32, + 123,13,31,32,16,5,8,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,13,31,32, + 034,12,0,1,14,17,32,12,0,1,12,0,1,14,9,16,11,31,32, + 12,0,1,14,17,32,11,31,32,12,0,1,14,9,16,12,0,1, + 035,12,0,1,14,1,2,12,0,1,12,0,1,14,1,2,12,0,1, + 12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,12,0,1, + 131,14,0,1,16,17,32,14,0,1,14,1,16,16,17,32,13,31,32, + 14,0,1,16,9,16,14,0,1,14,1,32,16,17,32,14,0,1, + 133,14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,13,31,32, + 130,14,0,1,16,17,32,14,0,1,14,0,1,16,17,32,13,31,32, + 14,0,1,16,9,16,14,0,1,14,1,32,16,1,2,14,0,1, + 132,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,17,32,14,0,1, + 028,12,0,1,14,17,32,12,0,1,12,0,1,14,1,2,12,0,1, + 11,31,32,14,1,2,12,1,32,12,1,32,14,9,16,11,31,32, + 036,12,0,1,14,1,2,12,0,1,12,0,1,14,1,2,12,0,1, + 12,0,1,14,9,16,12,0,1,12,0,1,14,17,32,12,0,1, + 038,12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,11,31,32, + 11,31,32,14,9,16,12,0,1,12,0,1,14,17,32,12,0,1, + 127,14,0,1,16,17,32,14,1,32,14,0,1,16,9,16,13,31,32, + 14,0,1,16,17,32,14,0,1,14,1,32,16,17,32,14,0,1, + 134,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 13,31,32,16,17,32,14,0,1,14,0,1,16,1,2,14,0,1, + 136,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 128,14,0,1,16,9,16,14,0,1,14,0,1,16,17,32,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 039,12,0,1,14,9,16,12,0,1,11,31,32,14,17,32,12,0,1, + 12,0,1,14,17,32,12,0,1,11,31,32,14,17,32,12,0,1, + 040,12,0,1,14,17,32,12,0,1,11,31,32,14,17,32,12,0,1, + 11,31,32,14,9,16,12,0,1,12,0,1,14,1,2,12,1,32, + 137,14,0,1,16,17,32,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 124,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,17,32,14,1,32, + 041,12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,12,0,1, + 11,31,32,14,17,32,12,1,32,12,0,1,14,17,32,12,0,1, + 033,12,0,1,14,17,32,12,0,1,12,0,1,14,1,2,12,1,32, + 12,0,1,14,17,32,12,0,1,11,31,32,14,17,32,12,1,32, + 138,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 030,11,31,32,14,1,2,12,1,32,12,0,1,14,17,32,11,31,32, + 12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,12,0,1, + 139,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 135,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 13,31,32,16,9,16,14,1,32,14,0,1,16,9,16,14,0,1, + 141,14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 14,0,1,16,9,16,14,0,1,14,0,1,16,9,16,14,0,1, + 042,11,31,32,14,9,16,12,0,1,12,0,1,14,17,32,12,0,1, + 12,0,1,14,17,32,12,0,1,12,0,1,14,17,32,12,0,1/ 11 FORMAT (2X,I5,6F7.2) DO I=1,70 ! convert above garbage to cm DO J=1,12 DCM(I,J)=(DIST(J*3-1,I)+ + FLOAT(DIST(J*3,I))/FLOAT(DIST(J*3+1,I)))*2.54 ENDDO ENDDO DO I=1,24 ! map from chamber # to sec,lay DO J=0,1 Q=MAP(J+1,I) DO K=1,70 IF (DIST(1,K).EQ.Q) GOTO 666 ENDDO 666 DO L=1,12 DMCM(I,J+1,L)=DCM(K,L) ENDDO ENDDO ENDDO * Fetch the dead channels OPEN(UNIT=66,FILE='dead_channels.dat',STATUS='old') 25 FORMAT(1x,I2,2x,I2,3x,I2) I=1 24 READ (66,25,END=18) (BAD(K,I),K=1,3) I=I+1 GO TO 24 18 CONTINUE NUMBADST=I-1 CLOSE(UNIT=66) OPEN(UNIT=67,FILE='peaks.dat',STATUS='OLD') 15 format(1x,I2,2x,I2,3x,I2,2x,F9.4,2x,F9.4,2x,F9.4,2x,F9.4) DO I=1,24 ! Read peak and width data DO L=0,1 DO M=0,23+L*4 READ (67,15) I2,L2,M2,(PEAKCAL(I2,L2+1,M2+1,K),K=1,4) READ (67,15) I2,L2,M2,(WIDTHCAL(I2,L2+1,M2+1,K),K=1,4) ENDDO ENDDO ENDDO CLOSE(UNIT=67) OPEN(UNIT=66,FILE='sc_dtt.try',STATUS='NEW') 12 FORMAT (3A4,5A10) 13 FORMAT (3I4,F10.4,F10.2,F10.4,F10.2,F10.1) 26 FORMAT + ('# RSSC Z calibration from Fe55 Run49000-52000 , July 2002, + Shaomin Chen') 27 FORMAT ('#') WRITE (66,26) WRITE (66,27) WRITE (66,12) 'SEC','LAY','CHN','SLOPE1','INT1', + 'SLOPE2','INT2','MIDDLE' SL1_OLD=0. IN1_OLD=0. SL2_OLD=0. IN2_OLD=0. MID_OLD=1080. DO I=1,24 ! compute 2 slopes and 2 intercepts DO L=0,1 ! and switchover point. DO M=0,23+L*4 III=M/2 KKK=1-M+III*2 ! compute avg posn of Fe55 source POS(1)=(-DMCM(I,L+1,KKK*6+1)+DMCM(I,L+1,KKK*6+2) + +DMCM(I,L+1,KKK*6+3)-DMCM(I,L+1,KKK*6+4) + +DMCM(I,L+1,KKK*6+5)+DMCM(I,L+1,KKK*6+6))/4 POS(2)=(-DMCM(I,L+1,KKK*6+1)-DMCM(I,L+1,KKK*6+2) + +DMCM(I,L+1,KKK*6+3)-DMCM(I,L+1,KKK*6+4) + -DMCM(I,L+1,KKK*6+5)+DMCM(I,L+1,KKK*6+6))/4 SL1=1/(PEAKCAL(I,L+1,M+1,2)-PEAKCAL(I,L+1,M+1,1))* + (POS(2)-POS(1)) SL2=1/(PEAKCAL(I,L+1,M+1,4)-PEAKCAL(I,L+1,M+1,3))* + (POS(1)-POS(2)) IN1=POS(1)-SL1*PEAKCAL(I,L+1,M+1,1) IN2=POS(2)-SL2*PEAKCAL(I,L+1,M+1,3) MID=(IN1-IN2)/(SL2-SL1) IF (SL1.GE.-0.20.OR.SL1.LE.-0.49.OR. + WIDTHCAL(I,L+1,M+1,1).GE.12.9.OR. + WIDTHCAL(I,L+1,M+1,2).GE.12.9.OR. + WIDTHCAL(I,L+1,M+1,3).GE.12.9.OR. + WIDTHCAL(I,L+1,M+1,4).GE.12.9.OR. + WIDTHCAL(I,L+1,M+1,1).LE.1.OR. + WIDTHCAL(I,L+1,M+1,2).LE.1.OR. + WIDTHCAL(I,L+1,M+1,3).LE.1.OR. + WIDTHCAL(I,L+1,M+1,4).LE.1.OR. + WIDTHCAL(I,L+1,M+1,1).EQ.4.0.OR. + WIDTHCAL(I,L+1,M+1,2).EQ.2.0.OR. + WIDTHCAL(I,L+1,M+1,3).EQ.2.0.OR. + WIDTHCAL(I,L+1,M+1,4).EQ.2.0.OR. + SL2.GE.0.49.OR.SL2.LE.0.20) THEN BDST=.FALSE. DO J=1,NUMBADST IF(BAD(1,J).EQ.I.AND.BAD(2,J).EQ.L. + AND.BAD(3,J).EQ.M) BDST=.TRUE. ENDDO IF (.NOT.BDST)THEN WRITE(6,*)'Cannot find the slopes, use the adjacent' WRITE(6,*)'ones instead.' SL1 = SL1_OLD IN1 = IN1_OLD SL2 = SL2_OLD IN2 = IN2_OLD MID = MID_OLD END IF ELSE * keep the values and may be used for a dead channel SL1_OLD = SL1 IN1_OLD = IN1 SL2_OLD = SL2 IN2_OLD = IN2 MID_OLD = MID ENDIF WRITE (66,13) I,L,M,SL1,IN1,SL2,IN2,MID ENDDO ENDDO ENDDO CLOSE(UNIT=66) END