CTITLEFJJUST -- JUSTIFY INPUT DATA FIELDS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR B. J. BUCK 00020000 CA DESIGNER B. J. BUCK 00030000 CA LANGUAGE VSFORTRAN 00040000 CA SYSTEM IBM & CRAY 00050000 CA WRITTEN 01-12-79 00060000 C REVISED 06-20-86 REM - COPIED JGJUST FROM R&D AND KEPT ONLY THE 00070000 C CODE WHICH DOES JUSTIFICATION. 00080000 C REVISED 10-29-86 REM - CHECK FOR NO SORT FLAG AND DO NOT JUSTIFY 00090000 C IT. 00100000 C REVISED 05-04-87 REM - CHANGE COMMON TO JUSTKY FOR NEW FORTRAN 00110000 C PTABMSTR. 00120000 C REVISED 07-07-87 DPH - RETURN WITHOUT JUSTIFICATION IF KEY AND 00130000 C DEFAULT KEY NOT FOUND -- ELIMINATE 00140000 C POSSIBLE INFINITE LOOP. 00150000 C REVISED 11-16-87 REM - CHANGE JUST KEYS FROM CHAR TO INTEGER. 00160000 C REVISED 06-02-88 TJT - RETURN WITHOUT JUSTIFICATION IF COLS 8-10 00161002 C ARE 'C' OR 'LBL' . 00162002 CA 00170000 CA 00180000 CA CALL FJJUST (CARD, KEY) 00190000 CA 00200000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00210000 CA 00220000 CA IN/OUT CARD CH80 DATA CARD TO BE JUSTIFIED 00230000 CA IN JEY CH2 JUSTIFICATION KEY 00240000 CA 00250000 CA FJJUST IS A SUBROUTINE CALLED BY CPPREP AS DATA CARDS ARE INPUT 00260000 CA TO JUSTIFY EACH FIELD BEFORE IT IS SORTED. 00270000 CAEND 00280000 C 00290000 SUBROUTINE FJJUST (CARD, KEY) 00300000 C 00310000 IMPLICIT INTEGER(A-Z) 00320000 C 00330000 PARAMETER (NCOLS=15, NLINES=3, NKEYS=15) 00340000 C 00350000 COMMON /JUSTKY/ JKEY, JKEYID 00360000 C 00370000 C CHARACTER VARIABLES IN THE PARAMETER LIST 00380000 C 00390000 CHARACTER*80 CARD 00400000 CHARACTER*2 KEY 00410000 C 00420000 C COMMON VARIABLES 00430000 C 00440000 INTEGER JKEY (NCOLS, NLINES, NKEYS) 00450000 INTEGER JKEYID (NKEYS) 00460000 C 00470000 C CHARACTER VARIABLES AND CONSTANTS -- LOCAL 00480000 C 00490000 CHARACTER*2 BLANK 00500000 CHARACTER*80 CARD1 00510000 CHARACTER*2 CHONE 00520000 CHARACTER*1 CHZERO 00530000 CHARACTER*8 CKEY 00540000 CHARACTER*1 FILL 00550000 C 00560000 C DATA DEFINITIONS 00570000 C 00580000 DATA BLANK /' '/ 00590000 DATA CHONE /'01'/ 00600000 DATA CHZERO /'0'/ 00610000 C 00620000 C CONVERT KEY TO INTEGER 00630000 C 00640000 CKEY = KEY 00650000 IKEY = S1CVBN (CKEY, 1, 2) 00660000 C 00670000 C FIND THE JUST KEY INDEX 00680000 C 00690000 DEFLT = 0 00700000 50 DO 60 JNO = 1, NKEYS 00710000 IF (IKEY .EQ. JKEYID(JNO)) GO TO 70 00720000 C 00730000 60 CONTINUE 00740000 C 00750000 C USE THE DEFAULT SORT KEY WHEN KEY NOT FOUND 00760000 C 00770000 IF (DEFLT .EQ. 1) GO TO 150 00780000 IKEY = 1 00790000 DEFLT = 1 00800000 GO TO 50 00810000 C 00820000 C DO NOT JUSTIFY COMMENT CARDS 00830000 C 00840000 70 IF (CARD(8:10) .EQ. ' C') GO TO 150 00850000 IF (CARD(8:10) .EQ. ' C ') GO TO 150 00851001 IF (CARD(8:10) .EQ. 'C ') GO TO 150 00852001 IF (CARD(8:10) .EQ. 'LBL') GO TO 150 00853001 NOSORT = 0 00860000 C 00870000 C CHECK FOR NO SORT FLAG - SO IT IS NOT JUSTIFIED 00880000 C 00890000 IF (CARD(8:8) .EQ. '^') THEN 00900000 CARD(8:8) = BLANK(:1) 00910000 NOSORT = 1 00920000 END IF 00930000 C 00940000 CARD1 = CARD 00950000 C 00960000 C INDIVIDUAL FIELD SHIFT LOOP 00970000 C 00980000 DO 130 ICOL = 1, NCOLS 00990000 IF (JKEY(ICOL, 1, JNO) .EQ. 0) GO TO 140 01000000 C 01010000 C PICK UP FILL CHARACTER AND SHIFT DIRECTION 01020000 C SHIFT=-1: RIGHT JUSTIFY 01030000 C SHIFT= 1: LEFT JUSTIFY 01040000 C 01050000 FILL = BLANK(1:1) 01060000 SHIFT = -1 01070000 IF (JKEY(ICOL, 3, JNO) .EQ. 2) THEN 01080000 FILL = CHZERO 01090000 ELSE IF (JKEY(ICOL, 3, JNO) .EQ. 3) THEN 01100000 SHIFT = 1 01110000 ELSE IF (JKEY(ICOL, 3, JNO) .EQ. 4) THEN 01120000 FILL = CHZERO 01130000 SHIFT = 1 01140000 END IF 01150000 C 01160000 IF (SHIFT .LE. 0) THEN 01170000 GO TO 80 01180000 ELSE 01190000 GO TO 90 01200000 END IF 01210000 C 01220000 80 BGN = JKEY(ICOL, 1, JNO) 01230000 I = JKEY(ICOL, 2, JNO) 01240000 END = JKEY(ICOL, 2, JNO) 01250000 GO TO 100 01260000 C 01270000 90 I = JKEY(ICOL, 1, JNO) 01280000 BGN = JKEY(ICOL, 1, JNO) 01290000 END = JKEY(ICOL, 2, JNO) 01300000 C 01310000 100 END1 = END - 1 01320000 C 01330000 C INDIVIDUAL COLUMN SHIFT LOOP 01340000 C 01350000 DO 120 N = BGN, END 01360000 IF (CARD1(I:I) .NE. BLANK(1:1)) GO TO 130 01370000 I1 = I 01380000 C 01390000 C SHIFT EACH CHARACTER ONE POSITION 01400000 C 01410000 DO 110 NA = BGN, END1 01420000 CARD1(I1:I1) = CARD1(I1+SHIFT:I1+SHIFT) 01430000 I1 = I1 + SHIFT 01440000 C 01450000 110 CONTINUE 01460000 C 01470000 C INSERT FILL CHARACTER -- JUSTIFIED 01480000 C 01490000 CARD1(I1:I1) = FILL 01500000 C 01510000 120 CONTINUE 01520000 C 01530000 130 CONTINUE 01540000 C 01550000 140 CARD = CARD1 01560000 IF (NOSORT .NE. 0) CARD(8:8) = '^' 01570000 C 01580000 150 RETURN 01590000 END 01600000