SUBROUTINE XRFINI C IMPLICIT LOGICAL*1 (B) DOUBLE PRECISION SYMBOL COMMON/PARAMS/LUNIN,LUNOUT,LUNCMD,BTAB,BSPC,NLINE,NSTMT, 1ICLASS,BCHR,BLST,JSYM(2),NSYMTP,IPARNS,NPAGE COMMON /INBUFR/INSIZ,INCNT,IOUTX,MCRSIZ,INFIL,IOUTFL, 1BDPB(2),BUFR(80),BNAM(24),BTIME(8),BDATE(9),BX(1) COMMON NSYM,NELM,KLIM,SYMBOL(1000) C EXTERNAL NXTCHR CALL CLOSE(LUNOUT) CALL CLOSE(LUNIN) CALL GETMCX (BUFR,MCRSIZ) IF (MCRSIZ.LE.0) GO TO 30 !READ TI: DO 10 IOUTFL=4,MCRSIZ IF (BUFR(IOUTFL).EQ.32) GO TO 15 10 CONTINUE GO TO 30 15 IOUTFL=IOUTFL+1 !POINT AT OUTPUT SPECIFIER INCNT=MCRSIZ GOTO 35 C C READ TI: FOR COMMAND C C 30 WRITE (LUNCMD,500) 500 FORMAT ('$XRF>') READ (LUNCMD,510,END=69)BUFR 510 FORMAT (72A1) IOUTFL=1 INCNT=72 32 IF(BUFR(INCNT).NE.32)GOTO 35 INCNT=INCNT-1 GOTO 32 35 BUFR(INCNT+1)=0 C C*** LOOK FOR IN/OUT DELIMITER (IE:'=') C 40 DO 45 INFIL=IOUTFL,INCNT IF (BUFR(INFIL).EQ.61) GO TO 60 45 CONTINUE C C COMMAND ERROR -NO'=' C WRITE (LUNCMD,520) 520 FORMAT ('!!!CMD ERROR!!! OUT=IN PLEASE!') IF (MCRSIZ.GT.0) CALL EXIT GO TO 30 60 BUFR(INFIL)=0 !TERMINATE OUTPUT SPEC. INFIL=INFIL+1 CALL CLOSE(LUNCMD) !FREE UP BUFFER CALL ASSIGN(LUNOUT,BUFR(IOUTFL)) C DEFAULT TO .FOR ON INPUT FILE IPDFLA=0 DO 62 I=INFIL,INCNT IF(BUFR(I).EQ.46) IPDFLA=1 62 CONTINUE IF(IPDFLA.EQ.1)GOTO 65 BUFR(INCNT+1)=46 BUFR(INCNT+2)=70 BUFR(INCNT+3)=79 BUFR(INCNT+4)=82 BUFR(INCNT+5)=0 INCNT=INCNT+4 65 CALL ASSIGN(LUNIN,BUFR(INFIL)) C C NOW SET TITLE C J=1 DO 70 I=INFIL,INCNT BNAM(J)=BUFR(I) J=J+1 70 CONTINUE DO 80 J=J,24 !FILL REST WITH SPACES BNAM(J)=32 80 CONTINUE IPARNS=0 NELM=KLIM NLINE=0 NPAGE=0 NSYM=0 NSTMT=0 CALL TIME(BTIME) CALL DATE(BDATE) CALL FRMCTL(0) IOUTX=INSIZ !SET BUFFER EMPTY BCHR=NXTCHR(IOUTX) !FORCE INITIAL READ RETURN 69 CALL EXIT END