CTITLEJDISPOS -- BUILD INFO CARDS FOR JOBGEN 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH MCMILLAN 00020000 CA DESIGNER RALPH MCMILLAN 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 10-30-87 00060000 C REVISED 2-25-88 REM. MAKE CRAY BLKSIZE MULTIPLE OF 8 AND >=3208 00070000 C REVISED 4-15-90 RDK. INSTALL CHANGES FOR UNICOS ON CRAY. 00070000 CA 00080000 CA CALL JDISPOS (INFO, BLKSIZ, OUT, ERR) 00090000 CA 00100000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00110000 CA IN INFO CH80 INFO2 CARD 00120000 CA IN BLKSIZ I4 NORMAL TRACE LENGTH IN BYTES 00130000 CA IN OUT I4 OUTPUT UNIT FOR DISPOSE CARDS 00140000 CA OUT ERR I4 RETURN STATUS (0 = OK; NOT 0 = ERROR) 00150000 CA 00160000 CA 00170000 CA THIS SUBROUTINE TAKES THE INFORMATION PROVIDED ON THE INFO2 CARD 00180000 CA AND AFTER CALLING JSSPAC & USAPRM IT THEN GENERATES THE NECESSARY 00190000 CA CRAY JCL FOR A DISPOSE OF THE DATA SET. THE FORMAT OF THE INFO2 00200000 CA CARD IS CONTAINED IN SUBROUTINE JBINFO. THIS ROUTINE IS ONLY USED00210000 CA TO GENERATE THE DISPOSES FOR MSS/DISK DATA SETS. 00220000 C 00230000 SUBROUTINE JDISPOS (INFO, BLKSIZ, OUT, ERR) 00240000 C 00250000 IMPLICIT INTEGER (A-Z) 00260000 C 00270000 C INPUT VARIABLES 00280000 C 00290000 CHARACTER*80 INFO 00300000 C 00310000 C LOCAL VARIABLES 00320000 C 00330000 CHARACTER*80 CARD 00340100 CHARACTER*80 CRDISP /'dispose DBG000 -f BB -d ST 00350000 * \ '/ 00360000 CHARACTER*80 IF /'if test -s DBG000 '/ 00360100 CHARACTER*80 THEN /'then '/ 00360110 CHARACTER*80 ENDIF /'fi '/ 00360200 CHARACTER*44 DSNAME 00370000 CHARACTER*4 DSORG 00380000 CHARACTER*4 KPNA 00390000 CHARACTER*6 MSVGP 00400000 CHARACTER*4 RECFM 00410000 CHARACTER*6 UNIT 00420000 C 00430000 C 00440000 ERR = 0 00450000 C 00460000 CARD ( 1:80) = IF (1:80) 00460100 CARD (13:18) = INFO(13:18) 00460200 WRITE (OUT, 9000) CARD 00460210 CARD ( 1:80) = THEN (1:80) 00460220 WRITE (OUT, 9000) CARD 00460230 CARD ( 1:80) = CRDISP(1:80) 00460300 CARD (13:18) = INFO(13:18) 00460400 WRITE (OUT, 9000) CARD 00480000 DSNAME = INFO(19:62) 00490000 IDOT = 0 00500000 C 00510000 C FIND THE END OF THE FOURTH PART OF THE DATA SET NAME 00520000 C 00530000 DO 10 J = 23,44 00540000 NCHR = J - 1 00550000 IF (DSNAME(J:J) .EQ. '.') IDOT = J 00560000 IF (DSNAME(J:J) .EQ. ' ') GO TO 20 00570000 C 00580000 10 CONTINUE 00590000 C 00600000 NCHR = 44 00610000 C 00620000 C FILL AND OUTPUT THE DATA SET NAME 00630000 C 00640000 20 CARD = '-t ''DSN=' 00650100 CARD(11:10+NCHR) = DSNAME(1:NCHR) 00660000 CARD(11+NCHR:14+NCHR) = ',''\ ' 00670000 WRITE (OUT, 9000) CARD 00680000 C 00690000 C GET SPACE REQUIREMENTS 00700000 C 00710000 FCRND = 4 00720000 LRECL = BLKSIZ 00730000 KPNA = INFO(6:9) 00740000 KPRNO = S1CVBN (INFO,10,1) 00750000 OCCUR = S1CVBN (INFO,11,2) 00760000 CALL JSSPAC (KPNA, KPRNO, OCCUR, LRECL, PRIM, SEC, RLSE, 00770000 * CONT, ERR, FCRND) 00780000 IF (ERR .NE. 0) GO TO 1000 00790000 C 00800000 C CRAY BLOCK SIZE MUST BE MULTIPLE OF 8 00810000 C 00820000 LRECL = ((LRECL+7) / 8) * 8 00830001 C 00840000 C GET DATA CARD 00850000 C 00860000 DA = 1 00870000 C 00880000 30 CALL FORC (KPNA, KPRNO, DA, CARD, *2000) 00890000 IF (CARD(8:10) .NE. ' ') GO TO 30 00900000 C 00910000 CALL USAPRM (LRECL, PRIM, CARD, UNIT, MSVGP, RECFM, PRI, SEC, 00920000 * VOLCNT, DSORG, PERMA, FREEC, RETGRP, STATUS) 00930000 IF (STATUS .GT. 1) THEN 00940000 ERR = 1 00950000 GO TO 1000 00960000 END IF 00970000 C 00980000 C CRAY BLOCK SIZE MUST BE >= 3208 00990000 C 01000000 IF (LRECL .LT. 3208) LRECL = 3208 01010000 C 01020000 C THE DCB RECORD IS NEXT 01030000 C 01040000 CARD = '''DCB=(RECFM=' 01050100 CARD(13:16) = RECFM 01060000 NCOL = 14 01070000 40 IF (CARD(NCOL:NCOL) .EQ. ' ') GO TO 50 01080000 NCOL = NCOL + 1 01090000 GO TO 40 01100000 C 01110000 50 CARD(NCOL:NCOL+19) = ',BLKSIZE= ),''\ ' 01120000 C*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$ 01130000 C 01140000 C THE FOLLOWING IF STATEMENT IS USED TO INSURE RECORDS ARE NOT 01150000 C TRUNCATED WHEN COMING BACK FROM THE CRAY. JSSPAC DOES NOT ALWAYS 01160000 C RETURN THE PROPER BLKSIZE FOR PLOT DATA SETS AND THIS WAS THE 01170000 C PLACE OF LEAST RESISTANCE TO CHANGE IT. TO BE EXACTLY PROPER, 01180000 C JSSPAC SHOULD RETURN THE PROPER VALUE!!!!!!!!!!!! 01190000 C 01200000 C*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$ 01210000 IF (IDOT .NE. 0) THEN 01220000 IF (DSNAME(IDOT+1:IDOT+4) .EQ. 'VARN') LRECL=32760 01230000 END IF 01240000 C*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$ 01250000 CALL S1BNCV (LRECL, CARD, NCOL+9, 5) 01260000 WRITE (OUT, 9000) CARD 01270000 C 01280000 C NOW DO THE SPACE PARAMETERS 01290000 C 01300000 CARD = '''SPACE=(TRK,( , ),RLSE),''\ ' 01310000 CALL S1BNCV (PRI, CARD, 14, 5) 01320000 CALL S1BNCV (SEC, CARD, 20, 5) 01330000 WRITE (OUT, 9000) CARD 01340000 C 01350000 C NOW DO THE UNIT PARAMETER 01360000 C 01370000 CARD = '''UNIT=( ' 01380000 CARD(08:13) = UNIT 01390000 NCOL = 14 01400000 C 01410000 60 NCOL = NCOL - 1 01420000 IF (CARD(NCOL:NCOL) .EQ. ' ') GO TO 60 01430000 CARD(NCOL+1:NCOL+5) = '),''\ ' 01440000 WRITE (OUT, 9000) CARD 01450000 C 01460000 C CHECK FOR MSS GROUP 01470000 C 01480000 IF (MSVGP .NE. ' ') THEN 01490000 CARD = '''MSVGP=' // MSVGP // ',''\ ' 01500000 WRITE (OUT, 9000) CARD 01510000 END IF 01520000 C 01530000 C CHECK FOR VOLUME COUNT 01540000 C 01550000 IF (VOLCNT .NE. 0) THEN 01560000 CARD = '''VOL=(,,, ),''\ ' 01570000 CALL S1BNCV (VOLCNT, CARD, 10, 3) 01580000 WRITE (OUT, 9000) CARD 01590000 END IF 01600000 C 01610000 C FINISH UP WITH DISPOSITION 01620000 C 01630000 CARD = '''DISP=(NEW,CATLG)'' ' 01640000 WRITE (OUT, 9000) CARD 01650000 C 01650010 C TERMINATE WITH ENDIF 01650020 C 01650030 CARD(1:80) = ENDIF(1:80) 01650100 WRITE (OUT, 9000) CARD 01650200 C 01660000 1000 RETURN 01670000 C 01680000 2000 ERR = 2 01690000 GO TO 1000 01700000 C 01710000 9000 FORMAT (A80) 01720000 END 01730000