SUBROUTINE GTCHR(ICHAR,FILNAM,IRSTW,IEOF,IRJUST) C GETS SEQUENTIAL CHARACTERS IN 6-BIT ASCII RIGHT JUSTIFIED FROM C THE SPECIFIED ".DA" FILE. SWITCH IRSTW IS USED TO REOPEN A FILE C AT THE START OF THE FILE OR TO GET THE NEXT CHARACTER IN THE FILE C THE FILE EOF IS DETECTED BY THE EOF(IFLAG) ROUTINE WHICH DETECTS C CONTROL/Z CHARACTERS. A LINE MAY BE UP TO 127 CHARACTERS LONG C ANY LEGAL 6-BIT CHARACTER IS ALLOWED C ARGUMENTS : C ICHAR = NEXT CHAR IN THE FILE (=-1 AT END OF LINE) C FILNAM = THE *.DA ASCII SOURCE FILE NAME C IRSTSW = 0 TO GET THE NEXT CHARACTER C = 1 TO REOPEN A FILE C = 2 PRINT OUT THE CURRENT LINE ON THE OUTPUT DEVICE C = 3 TO UNDERLINE THE CURRENT CHARACTER IN THE LINE C IEOF = 0 NO EOF FOUND ON THIS CHARACTER C = 1 EOF FOUND ON THIS CHARACTER C IRJUST = 0 TO LEFT JUSTIFY C = 1 TO RIGHT JUSTIFY C FORTRAN II / OPTION (I) C SR : UTILEO.SB DIMENSION IA(128) IERRMSG=1 C SWITCH OFF THE EOF SWITCH IEOF=0 C TEST IF THE FILE IS TO BE OPENED IF(IRSTW-1)2,1,20 C DO A SYS LOOKUP OF THE FILENAME 1 CALL IOPEN('SYS',FILNAM) C RESET THE EOF FLAG CALL EOF(ICHY) IEND=0 C ISPACE IS THE VALUE OF "SPACE" LEFT JUSTIFIED ISPACE=32*64+32 ICOUNT=0 C GET THE NEXT CHARACTER C TEST IF NEED A NEW BUFFER 2 IF(ICOUNT-IEND)10,3,10 C NEED A NEW BUFFER - ZERO IT OUT FIRST 3 DO 4 I=1,128 4 IA(I)=0 READ(4,101)(IA(J),J=1,128) 101 FORMAT(128A1) C NOW PUSH A CARRIAGE RETURN C TEST IF THERE ARE EXTRA SPACES AT THE END OF THE LINE DO 6 K=1,127 L=128-K C COUNT BACKWARDS - SEE IF ZERO ISSS=IA(L)-ISPACE IF(ISSS)7,6,7 6 CONTINUE 7 IEND=L C WHERE IEND IS THE INDEX OF THE LAST NON SPACE CHARACTER ICHAR=-1 ICOUNT=0 RETURN C NOW GET THE DATA CHARACTER REQUESTED 10 ICOUNT=ICOUNT+1 C STRIP OFF THE SPACE IN THE SECOND CHARACTER POSITION ICHAR=IA(ICOUNT)-32 C RIGHT JUSTIFY S CLA CLL S TAD I \ICHAR S RTR;RTR;RTR S AND (0077 S DCA \ICH / SAVE IT C TEST IF RIGHT JUSTIFY IF(IRJUST-1)17,16,17 16 ICHAR=ICH C TEST IF EOF 17 CALL EOF(ICHY) IF(ICHY+1)19,18,19 18 IEOF=1 19 RETURN C SEE IF PRINT OR UNDERLINE IT 20 IF(IRSTW-2)22,22,23 22 WRITE(IERRMSG,101)(IA(K),K=1,IEND) RETURN C UNDERLINE IT 23 ISPC=32*64 K1=ICOUNT-1 IUPAR=30*64 WRITE(IERRMSG,101)(ISPC,K=1,K1),IUPAR RETURN END