SUBROUTINE CMDCMP ! Compress the command line. INCLUDE 'IPCOMM' ISPACE = .TRUE. ! Assume it starts with a space. IPLOC = IPSLOC ! Save original location IPLEN = IPSLEN ! and length. IPSLEN = 0 ! Init the length. IPSLOC = 1 ! Init the location. IF (IPLEN .LE. 0) RETURN ! If no command, return. DO 1090 I=IPLOC,IPLOC+IPLEN-1 ! Iterate thru the buffer. IF (IPBUF(I) .LE. 32) ! If a space, 1 GO TO 1020 ! go handle it. IF (IPBUF(I) .EQ. 47) ! If a slash, 1 GO TO 1030 ! go handle it. IF (IPBUF(I) .GE. 97 .AND. ! If lowercase, 1 IPBUF(I) .LE. 122) ! ... 2 IPBUF(I) = IPBUF(I)-32 ! convert to uppercase. GO TO 1070 ! Go handle normally. 1020 IF (ISPACE) GO TO 1090 ! If already have one, skip. ISPACE = .TRUE. ! Now we have one. IPBUF(I) = 32 ! Force a space. GO TO 1080 ! Go fill it in. 1030 IF (ISPACE .AND. ! If have a leading space and 1 IPSLEN .GT. 0) ! the buffer is occupied, 2 IPSLEN = IPSLEN - 1 ! squeeze the space out. GO TO 1070 ! Go handle normally. 1070 ISPACE = .FALSE. ! No space. 1080 IPSLEN = IPSLEN + 1 ! Update length. IPBUF(IPSLEN) = IPBUF(I) ! Copy the character. 1090 CONTINUE ! Repeat until done. IF (IPSLEN .LE. 0) RETURN ! If no command, return. IF (ISPACE) IPSLEN = IPSLEN - 1 ! If trailing space, trim. RETURN ! Return to caller. END ! End of subroutine. SUBROUTINE MOVSTR(LEN,SRC,DST) ! Move a string. Overlap legal. INTEGER*2 LEN ! Source string length. LOGICAL*1 SRC(LEN) ! Source string. LOGICAL*1 DST(LEN) ! Destination string. INTEGER*4 SRCADR ! Address of source string. INTEGER*4 DSTADR ! Address of destination string. INTEGER*2 I ! Index. SRCADR = 0 ! Clear hi word, so can DSTADR = 0 ! compare unsigned. CALL GETADR(SRCADR,SRC) ! Get the source address. CALL GETADR(DSTADR,DST) ! Get the destination address. IF (SRCADR .LT. DSTADR) ! If source comes before dest, 1 GO TO 200 ! do the copy back-to-front. DO 110 I=1,LEN ! Loop through the buffer, DST(I) = SRC(I) ! copying source to dest, 110 CONTINUE ! and repeating until done. GO TO 400 ! Return to caller. 200 DO 210 I=LEN,1,-1 ! Loop through the buffer, DST(I) = SRC(I) ! copying source to dest, 210 CONTINUE ! and repeating until done. GO TO 400 ! Return to caller. 400 RETURN ! Here's the return we promised. END ! End of module. SUBROUTINE LODSTR(LEN,SRC) ! Load a string into IPBUF. INTEGER*2 LEN ! Source string length. LOGICAL*1 SRC(LEN) ! Source string. INCLUDE 'IPCOMM/NOLIST' CALL MOVSTR (LEN, SRC, IPBUF(IPSLEN + 1)) IPSLEN = IPSLEN + LEN RETURN END SUBROUTINE TRMSTR (LEN) ! Trim blanks from IPBUF. INTEGER*2 LEN ! Blanks to leave at end. INCLUDE 'IPCOMM/NOLIST' INTEGER*2 ITER8 ! Iteration counter. IPSLEN = IPSLEN + 1 1000 IPSLEN = IPSLEN - 1 IF (IPSLEN .LE. 0) GO TO 1200 IF (IPBUF(IPSLEN) .EQ. ' ') GO TO 1000 1200 IF (LEN .EQ. 0) GO TO 1290 DO 1280 ITER8 = 1, LEN IPSLEN = IPSLEN + 1 IPBUF (IPSLEN) = ' ' 1280 CONTINUE 1290 CONTINUE RETURN END SUBROUTINE LODTIM (YR, MO, DA, HR, MI, SC) ! Format time. LOGICAL*1 YR ! Year LOGICAL*1 MO ! Month LOGICAL*1 DA ! Day LOGICAL*1 HR ! Hour LOGICAL*1 MI ! Minute LOGICAL*1 SC ! Second INCLUDE 'IPCOMM/NOLIST' LOGICAL*4 MNAMES (0:12) ! Month names. DATA MNAMES /'???', 1 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 2 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/ ENCODE (18, 94430, IPBUF(IPSLEN+1)) ! Create buffer showing 1 DA, MNAMES (MO), YR, HR, MI, SC 94430 FORMAT (I2, '-', A3, '-', I2, X, 2(I2, ':'), I2) IF (IPBUF (IPSLEN+8) .EQ. ' ') IPBUF (IPSLEN+8) = '0' IF (IPBUF (IPSLEN+14) .EQ. ' ') IPBUF (IPSLEN+14) = '0' IF (IPBUF (IPSLEN+17) .EQ. ' ') IPBUF (IPSLEN+17) = '0' IPSLEN = IPSLEN + 18 RETURN END