C SUBROUTINE MACHINE. C C MUST LOAD ACCT(LIB) EXPLICITLY. C SUBROUTINE MACHINE(SHORT,N,FREF) LOGICAL SHORT INTEGER ANS,FILE(6),FNAME(2),ACNT(6),ACC(2),RFC DIMENSION MACH(2,6),FR(6) DATA MACH/1,'TH80',1,'PICK',1,'CARL',2,'6MEV',1, &'NAVA',1,'ATLA'/,FR/80.,80.,60.,100.,80.,80./,NUM/6/, &FNAME(2)/'RFC)'/,FILE/'JTC(','JPC(','CPC(','HLA(','NTC(', &'APC('/,ACNT/'DOSE','DOSE','HARR','HMCH','USNH','ACH'/ &,RFC/'RFC'/ C LOGICAL UNIT 108 = TTY C UNIT 101 = MACHINE OUTPUT FILE C UNIT 102 = T/A FILE C C TH80 = JEFFERSON THERATRON C PICK = JEFFERSON PICKER C CARL = CARLISLE PICKER C 6MEV = HAHNEMAN LINEAR ACCELERATOR C NAVA = NAVAL HOSPITAL C ATLA = ATLANTIC CITY PICKER 1 IF(SHORT) GO TO 6 WRITE(108,100)N 100 FORMAT(1X,I2,': PLEASE TYPE THE MACHINE NAME') GO TO 7 6 WRITE(108,110) N 110 FORMAT(1X,I2,': MACHINE') 7 READ(108,120) ANS 120 FORMAT(A4) DO 15 K=1,NUM IF(ANS.NE.MACH(2,K)) GO TO 15 CALL ACCT(ACC) IF(ACC(1).EQ.RFC) GO TO 2 IF(ACC(1).NE.ACNT(K)) GO TO 1 2 IFILE=MACH(1,K) C IFILE IS T/A FILE INDEX FREF=FR(K) FNAME(1)=FILE(K) GO TO 8 15 CONTINUE GO TO 1 8 CALL F102 GO TO (21,22),IFILE C IFILE INDEX - 1= COBALT : SBRCO C 2= 6MEV : SBR6MV 21 CALL OPENF(102,'SBRCO(RFC)',1) GO TO 29 22 CALL OPENF(102,'SBR6MV(RFC)',1) 29 CALL F101 CALL OPENF(101,FNAME,1) RETURN END 8X