SUBROUTINE COPY (NUMBER, LIST1, LIST2) C The function of this subroutine is to copy NUMBER characters C from array LIST1 to array LIST2 when invoked by a FORTRAN C call. Parameter types are INTEGER*2 for NUMBER, and BYTE C arrays for LIST1 and LIST2. COPY must be used with care C when LIST1 and LIST2 are the same array. C Revision History: IMPLICIT INTEGER (A - Z) BYTE LIST1, LIST2 ; Arrays DIMENSION LIST1 (1), LIST2 (1) FOR LOOP = 1, NUMBER ; Loop NUMBER times LIST2(LOOP) = LIST1(LOOP) ; Copy one character END FOR RETURN END SUBROUTINE ALPINT (NUMBER, LABEL) C C The function of this subroutine is to convert an ASCII numeric C character, LABEL, to a binary number, NUMBER, when invoked by C a FORTRAN call. Parameter types are defined to be INTEGER*2 C for NUMBER and BYTE array for LABEL. C C Revision History: IMPLICIT INTEGER (A - Z) BYTE LABEL NUMBER = IAND(LABEL, 15) ; Wipe off top 12 bits RETURN END SUBROUTINE INTALP (NUMBER, LABEL) C C The function of this subroutine is to convert a binary integer C number, NUMBER, to the corresponding alphanumerics in array C LABEL, when invoked by a FORTRAN call. Parameter types are C defined to be INTEGER*2 for NUMBER, and BYTE array for LABEL. C Revision History: IMPLICIT INTEGER (A - Z) BYTE LABEL LOGICAL*1 FOUND DIMENSION LABEL (5) NUMBR2 = NUMBER ; Copy into NUMBR2 FOR LOOP = 1, 5 ; Max length of NUMBER is 5 INDEX = 6 - LOOP ; Array index LABEL(INDEX) = MOD(NUMBR2, 10) + 48 ; Add 48 to remainder NUMBR2 = NUMBR2 / 10 ; Update NUMBR2 END FOR FOUND = .FALSE. FOR LOOP = 1, 5 ; Suppress leading zeroes IF ((.NOT.(FOUND)) .AND. (LABEL(LOOP) .EQ. 48)) LABEL(LOOP) = 32 ; Replace '0' with blank ELSE ; A nonzero character FOUND = .TRUE. ; Set FOUND to TRUE END IF END FOR RETURN END FUNCTION NEXT (I) C C The purpose of this function is to return the next nonblank C character in LIST, as long as I is less than L. When I reaches C L, a blank is returned. Parameter types are INTEGER*2 for I C and L, and BYTE array for LIST. C Revision History: IMPLICIT INTEGER (A - Z) BYTE LABEL, LHEAD, LIST, CONLBL ; Common string variables LOGICAL*1 LISTNG, PASCOM ; Listing, pass comments flags COMMON /IFTCOM/ DONE, INFILE, IP, KIND, L, LNUM, LOUT, OUTFIL, + ERRCNT, LISTNG, PASCOM, CONLBL(6), LABEL(66), LHEAD(6), LIST(1320) DO I = I + 1 IF (LIST(I) .NE. 32) NEXT = LIST(I) RETURN END IF UNTIL (I .GT. L) NEXT = 32 RETURN END RETURN END