CTITLEUSRPAD -- RIGHT JUSTIFY A CHARACTER STRING AND PAD WITH INPUT CHAR00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR REGINA COTTON 00020000 CA DESIGNER J. M. PONTON 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 10-03-89 00060000 CA 00080000 CA CALL USRPAD (STRING, NC, PC) 00090000 CA 00100000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00110000 CA ------ -------- ---- ----------- 00120000 CA IN/OUT STRING CHAR STRING TO BE RIGHT-JUSTIFIED. 00130000 CA INPUT NC I4 LENGTH OF STRING 00140000 CA INPUT PC CHAR PADDING CHARACTER 00141000 CA 00150000 CA THIS SUBROUTINE REMOVES ANY TRAILING BLANKS IN 'STRING' AND SHIFTS00160000 CA THE REST OF THE WORD, PADDING THE RESULT WITH THE PAD CHARACTER. 00170000 CA 00180000 C EJECT 00190000 C 00200000 SUBROUTINE USRPAD (STRING, NC, PC) 00210000 C 00220000 IMPLICIT INTEGER (A-Z) 00230000 C 00240000 CHARACTER*(*) STRING 00250000 CHARACTER*1 PC 00251000 IF (NC .LE. 0) RETURN 00280000 C 00290000 C FIND THE LAST NON-BLANK CHARACTER. 00300000 C 00310000 DO 10 I = 1, NC 00320000 IF (STRING(NC-I+1:NC-I+1) .NE. ' ') GO TO 20 00330000 10 CONTINUE 00340000 C 00370000 RETURN 00380000 C 00390000 20 CONTINUE 00400000 SHIFT = I - 1 00410000 IF (SHIFT .EQ. 0) RETURN 00440000 C 00450000 C SHIFT THE STRING. 00460000 C 00470000 DO 30 I = 1, NC-SHIFT 00480000 STRING(NC-I+1:NC-I+1) = STRING(NC-SHIFT-I+1:NC-SHIFT-I+1) 00490000 30 CONTINUE 00500000 C 00510000 C PAD IT OUT WITH PAD CHARACTER 00520000 C 00530000 DO 40 I = 1, SHIFT 00540000 STRING(I:I) = PC 00550000 40 CONTINUE 00560000 C 00570000 RETURN 00580000 C 00590000 END 00600000