CALL MTDIO (1,3760,IN,ISTAT,IS) IF(IS.NE.1)GO TO 800 X TYPE "RECORD,IS",NR,IS JS=IS NR=NR+1 CALL XMTW(KEYT,JS,ERR=810) RETURN 800 CONTINUE IF((ISTAT.AND.400K).EO.400K) GO TO 805 WRITE(10,900)NR,ISTAT,IS 900 FORMAT(" MT READ ERROR REC= ",15," STATUS ",O10,15) RETURN 805 NR=NR-1 CALL MTDIO (1,40000K,IN,ISTAT,IS) X TYPE "EOF ",NR RETURN 810 TYPE "TAPIO XMT ERR ",NR IS=-1 RETURN END C..KORR.FR (CORR) C 21 AUG. 1975 W HOHAN (VERSION 2) C PARAMETER ANGX=-6.5 SUBROUTINE CORR(IER) COMMON IN(3760),R(750),V(750),X(512),W(512),ANGLE(194) COMMON/CO/CENTER(180),Y(180),JZX(4,12),FACT,SCALE,IANG COMMON/MOLTI/KEY,IBFR COMMON/IO/IOO(6),KTRL,IPM(6) CQUIVALENCE (ANG,IN(1)) CQUIVALENCE (IOO(1),L1),(IOO(2),L2),(IOO(3),L3) CQUIVALENCE (IOO(4),L4),(IOO(5),L5),(IOO(6),L6) DIMENSION ICOR(1024),CE(216),CY(216) EQUIVALENCE(XF,IN(918)) EQUIVALENCE(ICOR(1).IN(1)),(NRC,ICOR(920)) EQUIVALENCE(CE(1),IN(4)),(CY(1),IN(436)) C C CFILE IS ASSUMED TO BE OPENED C CALL RDBLE(L6,0,ICOR,4,IER) IF(IDR.NE.1) RETURN C Z=525.0/509.0 DO 20 J=1,12 D=Z/COS((ANGX+J)/57.29577951) DO 10 1=J,216,12 10 CY(1)=D 20 CONTINUE C FACT=XF iF(NRC.GT.3) GO TO 883 C II=NRC*12+1 IE=II+179 C MOVE CENTERS AND DISTANCE INTERVAL MEASUREMENTS C K=1 DO 100 I=II.IE CENTER(K)=CE(I) Y(K)=CY(I) 100 K-K+1 C C MOVE LEhD VALUES C Ks868 DO 250 J=1,12 DO 200 I=1,4 JZX(I,J)=ICOR(K) 200 K=K+1 258 CONTINUE C IF(KTRL.LT.8) RETURN WRITE(12,900)KTRL 900 FORMAT(" CENTER",10X,"PRINT FLAG: ",15) WRITE(12,901) CENTER 901 FORIIAT(" ",12F10.2) WRITE(12,902) 902 FORIIAT (" Y") WRITE(12,903) Y 903 FORMAT(" ",12F10.6) RETURN C 803 TYPE "LOGICAL REC ) 3",NRC IER=-1*NRC RETURN END C..RFDSKIO.FR (DSKIO) C 26 AUG 1975 W HOMAN C 10 SEPT 1975 J DEHNERT - CHANGES FOR COMBTNED INTERPOLATION, DIFFERENTIATION C PARAMETER LP=12 SUBROUTINE DSKIO (IS) COMMON IN(3760),R(750), V(750),X(512),W(512),ANGLE(194) COMMON/CO/CENTER(180),Y(180),JZX(4,12),FACT,SCALE,IANG CONNON/MDLTI/KEY,IDMYSFR CONNON/IO/IOO(6),KTRL,IPM(6) DIMEMSION IO(512) EQUIVALENCE(IO(1),V(1)) EQUIVALENCE (ANG,IN(1)) EQUIVALENCE (IOO(1),L1),(IOO(2),L2),(IOO(3),L3) EQUIVALENCE (IOO(4),L4),(IOO(5),L5),(IOO(6),L6) IS=1 1 CALL REC (KEYU,IL) IK=IL IPX=IANG-1 IF(KTRL.GT.10) WRITE(LP,900) IANG,IRX,IRX,IK,X(512),W(512) 900 FORMAT(" DSKIO",3I10,2F10.3) L=L3 C IF(IL.LT.0) GO TO 366 C CALL WRBLK(L3,IRX*4,X,4,IER) IF(IER.NE.1) GO TO 820 GO TO 1 300 CALL WRBLK(L3,IRX*4,W,4,IER) IF(IER.NE.1) GO TO 820 GO TO 1 C ', 820 IYPE "DSKIU(820) ERRUR",L,IER IS=TER RETURN END Annexe B Partie II ;ASSEMBLY LANGUAGE SUBROUTINE TO DO ;REFERENCE AND OFFSET CORRECTION ;ROBERT A.LEMAN ;SEPTEMBER 23,1975 .TITLE FSREFC R0=0 R1=1 R2=2 R3=3 F0=0 F1=1 F2=2 F3-3 ;SUBROUTINE TO PERFORM REFERENCE AND ;OFFSET CORECTION. THE ARGUMENTS ARE: ;THE ARRAY OF DETECTOR VALUES(REAL) ;THE ARRAY OF REFERENCE VALUES(REAL) ;THE OFFSET VALUE(REAL) ;THE NUMBER OF POINTS(INTEGER) ;THE CALL IS: ;CALL REFC ( , , ; , ) THE EOUATION SOLVED IS: ;V(I) = (V(I)/R(I)) - Z * POINTS > I > 1 ;THE VALUE IS RETURNED TO THE DETECTOR SOURCE ARRAY .ENT REFC .ZPEL REFC: REF .NREL REF:SAVE 0 ;AC0 = ADDRESS OF R(I) ;ACL = ADDRESS OF V(I) FLDS F2,@-5,R3 ;LOAD OFFSET "Z" LDA R2,@-6,R3 ;LOAD COUNT "N" MOV R1,R3 ;MOVE ADDRESS OF V(I) NEG R2,R1 ;NEGATE COUNT MOV R0,R2 ;MOVE ADDRESS OF R(I) LOOP: FLDS F0,0,R3 ;F0 = V(I) FDMS F0,0,R2 ;F0 = V(I)/R(I) ADI 2,R2 ;INCREMENT POINTER TO R(I) FSS F2,F0 ;F0 = V(I)/R(I) - Z FSTS F0,0,R3 ;STORE RESULT BACK ADI 2,R3 ;INCREMENT POINTER TO V(I) INC R1.R1 ,SZR ;DONE II POINTS? JMP LOOP ;NO, DO SOME MORE RTN ;YES, BYE .END ;END OF REF. SR Annexe B Par tie III C COVOL2.FR C C C PURPOSE--MAIN DRIVER FOR CONVOLUTION PRIOR C TO ENTERING THE BACK-PROJECTION PHASE C C *** 25 JUNE 1975 W. HOMAN C 6/25 PUT IN ALL CHANGES TO PGM MADE TO KOVOLE 5-10THRU 6-17 C 7/28 CHANGE TO ACCEPT NEW INPUT AND CALL NEW FFT C *** 14 AUGUST 1975 - J.DEHNERT C 21 AUGUST - MULTIPLE RECORD DUTPUT C PARAMETER REW=2,MSR=3,LPT=12,NRW=3,RAWBLK=4,MMS=4,MSRSLK=4 PARAMETER HCLEN=512,CLEN=2*HCLEN,DCLEN=2*CLEN PARAMETER MSLEN=NMS*HCLEN-1,RWLEN=NRW*HCLEN-1 PARAMETER FORWARD=0,REVERSE=1 COMMON/PARMS/IEXT,NDP,1B,NP,INPX(4),IOTX(6),IPARM(5),IFFH(4) COMMON /FCN/ CON(CLEN) COMMON /DATA/AMSR(0:MSLEN),FFT|(DCLEN),ARAW(0:RWLEN) C INTEGER T(6) C C C **** INITIAL IZE TYPE "CO 8/21/75 " CALL TIME(T,IER) KTIME=1 GO TO (50,800) CONIT(0) C **** MOTE THAT NDP MUST BE ODD 58 ICCNT=CLEN-NDP IRSTRT=ICCNT+1 ICSTRT=DCLEN-ICCNT+1 IPSTRT=NCLEN+1 C **** ENTER THE DATA PROCESSING LOOP:READ AND UNPACK DATA DO 500 IP=0,NP-1 IRW=MOD(IP,NRW) IF (IRW.EQ.0) CALL RDBLK (RAW.IP*RAWBLK,ARAW,RAWBLK*NRW,IER) CALL CHECK(IER) CALL COMUNP(ARAW(IRW*HCLEN),FFT(IRSTRT),NDP) C **** DATA NOW IN FFT(IRSTRT)-FFT(DCLEN-ICCNT), WITH REMAINDER CLEARED C **** PERFORN CONVOLUTION CALL DFTS (FFT,CLEN,FORWARD) CALL COMVOL (FFT,CON,CLEN) CALL DFTS (FFT,CLEN,REVERSE) C **** PACK DATA AND OUTPUT IMS=MOD(IP,MMS) IF (IMS.EQ.0) IP0=IP CALL. COMPCK(FFT(IPSTRT),AMSR(IMS*HCLEN),HCLEN) IF (IMS.EQ.NMS-1) CALL WRBLK(MSR,IP0*MSRBLK,AMSR,MSRBLK*NMS,IER) 500 CALL CHECK(IER) C **** EXIT CLOSE RRW CLOSE MSR CALL TIME(T(4),IER) IT = ((T(4)-T(1))*CO + T(S)-T(2))*60 + T(6)-T(3) TYPE "CONVOLUTION REQUIRED",IT." SECONDS." CALL FCHAN("C4,SV").