CTITLEUGALPF -- ALLOCATE A NEW PERMANENT SPARC PLOT FILE DATA SET 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR F.A. COADY 00020002 CA DESIGNER F.A. COADY 00030002 CA LANGUAGE FORTRAN 77 00040007 CA SYSTEM IBM / CRAY 00050002 CA SYSTEM S/3090 / X/MP 00060002 CA WRITTEN 08-05-85 00070002 C REVISED 12/30/85 FAC CLEANED UP DEBUG PRINT 00080002 CMULT REVISED 02/26/86 FAC ADDED MULTIPLE PLOT FILE CODE 00081002 C REVISED 11/26/86 FAC ADDED UNIRAS META FILE ALLOC 00082002 C REVISED 03/17/87 FAC ADDED BUILD OF DCB'S FOR UNIRAS META 00083002 C FILES (CALL GETDCB) 00084002 C REVISED 07/11/87 FAC MODIFIED FOR NEW PRODUCTION SPARC 00085002 C DYNAM PLOT FILE ALLOC USING UPNPLT. 00086002 C REVISED 08/18/87 FAC ADDED KPDSNS AREA. 00088002 C REVISED 01/14/88 FAC ADDED NREC=2700 FOR META FILES. 00089004 C REVISED 02/04/88 FAC CHANGED NREC FOR ESP TYPE FILES FROM 00089105 C 10000 TO 5000 FOR SWITCH TO DASD. 00089205 C REVISED 02/23/88 FAC ADDED COMMON /GUNITS/ & INITIALIZED 00089306 C ELEMENTS LU(1) & LU(11) FOR UNIRAS. 00089406 C REVISED 03/07/88 FAC REMOVED CHECK FOR CRAY EXECUTION TO 00089507 C ALLOW FOR CRAY PLOTTING. 00089607 C REVISED 00090002 CA 00100002 CA 00110002 CA CALL UGALPF (DSNAME,DDNAME, ERR,ERRIN) 00120002 CA 00130002 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00140002 CA 00150002 CA OUT DSNAME C44 NAME OF SEQUENTIAL DATA SET ALLOCATED: 00160002 CA 11R4 MASS STORAGE DATA SET ONLY. 00170002 CA 11I4 00180002 CA 00190002 CA OUT DDNAME A8 DD NAME OF ALLOCATED PLOT DATA SET. 00200002 CA IF UNIRAS PLOT THEN DDNAME = UNIRAS0N, 00210002 CA IF ESP TYPE PLOT THEN DDNAME = DBG00N, 00220002 CA WHERE N=OUTPUT PLOT COUNT FOR JOB. 00230002 CA 00240002 CA OUT ERR I4 ERROR CODE. 00250002 CA 1 = OK. 00260002 CA 2 = INVALID DATA SET TYPE CODE IN 00290002 CA COL 40 OF CARD. 00300002 CA 3 = COULD NOT OPEN SEISTRAN FILE 00310002 CA TO GET DATA SET NUMBER. 00320002 CA 4 = LINE NAME BLANK ON LINE CARD. 00330002 CA 5 = LINE NAME CONTAINS EMBEDDED BLANKS. 00340002 CA 6 = LINE NAME 8 CHARACTERS LONG AND 00341002 CA FIRST CHARACTER NOT ALPHABETIC. 00342002 CA 7 = INVALID CODE IN LAST FIELD OF CARD, 00343002 CA COLS. 76-80 OR 78-80. VALID CODES 00344002 CA ARE ESP, COL, OFTAD, AND BLANK. 00345002 CA 8 <---4 ) RETURN CODES 00346002 CA 9 <---8 ) FROM SVC 99. 00347002 CA 10 <--12 ) SEE IBM MANUAL BELOW, P. 27. 00348002 CA 11 = NOT USED (CLOSE FAILED). 00349002 CA 12 = GETMAIN (FOR DCB AREA) FAILED. 00349102 CA 13 = NOT USED (FREEMAIN FAILED). 00349202 CA 14 = NOT USED (DDNAME ALL BLANKS). 00349302 CA 15 = DATA SET NAME ALL BLANKS. 00349402 CA 16 = NREC ZERO OR NEGATIVE. 00349502 CA 18 = BLKSIZ ZERO OR NEGATIVE, OR > 32760. 00349602 CA 19 = BLKSIZ NOT A MULTIPLE OF LRECL. 00349702 CA 20 = BLKSIZ NOT EQUAL TO LRECL (SEISMIC). 00349802 CA 21 = PLTYPE NOT 1, 2, 3, OR 4. 00349902 CA 22 = TSO USERID RETRIEVAL ERROR. 00350002 CA 23 = NO DATA CARDS FOR PROCESS. 00350102 CA 24 = PLOTNO > KPDBGN & FAT'S EXIST. 00350202 CA 25 = UNIPICT FILE NOT ALLOCATED FOR CRAY. 00350302 CA 26-29 = USAPRM RETURNED ERROR (+24) 00350403 CA 99 = FIRST CARD OF PROCESS NOT FOUND. 00351002 CA 00360002 CA OUT ERRIN I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). 00370002 CA BYTES 1 AND 2 = ERROR CODE, 00380002 CA BYTES 3 AND 4 = INFORMATION CODE. 00390002 CA IBM MANUAL GC28-0627-2, OS/VS2 MVS 00400002 CA SYSTEM PROGRAMMING LIBRARY: 00410002 CA JOB MANAGEMENT, PAGES 28 TO 31.0. 00420002 CA 00430002 CA UGALPF IS A FORTRAN SUBROUTINE THAT CREATES A NEW, PERMANENT, 00440002 CA CATALOGED, SEQUENTIAL DATA SET ON MASS STORAGE OR TAPE FOR A 00450002 CA A SPARC OUTPUT PLOT FILE. COLUMNS 76-80 OF THE FIRST CARD FOR 00460002 CA THE CURRENT PROCESS ARE SCANNED FOR THE KEYS ONCOL, OFCOL, COL, 00470002 CA ONESP, OFESP OR ESP. IF ONE OF THESE KEYWORDS IS NOT FOUND THEN 00480002 CA NO PLOT FILE IS ALLOCATED AND RETURN WITH DDNAME = ' '. 00490002 CA 00500002 CA THE FILE ATTRIBUTE TABLE (FAT) AND DATA SET PROCESSING TABLE, 00510002 CA INDEXED BY KPDSNS, IS WRITTEN INTO RESERVED BLANK COMMON FOR USE 00511002 CA BY CSSMRY AT END OF SPARC JOB. 30 + 4*(NUMBER OF PLOT DATA SETS) 00520002 CA WORDS ARE USED, CARE SHOULD BE TAKEN NOT TO OVERWRITE THIS AREA. 00530002 CA 00540002 CA 00550002 CA 00800002 CAEND 00810002 SUBROUTINE UGALPF (DSNAME, DDNAME, ERR,ERRIN) 00820002 IMPLICIT INTEGER (A-Z) 00830002 C 00850002 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 2/26/86 00860002 COMMON /P/ STARTP ( 2) , M00000( 3) 00870002 COMMON /P/ LCTYP , M00020 00880002 COMMON /P/ LCBGSP 00890002 COMMON /P/ LCENSP , M00032( 3) 00900002 COMMON /P/ LCTPSP 00910002 COMMON /P/ LCRL 00920002 COMMON /P/ LCSI 00930002 COMMON /P/ LCPI , M00060( 10) 00940002 COMMON /P/ AC64BC , M00104( 4) 00950002 COMMON /P/ ACLNAM ( 5) 00960002 COMMON /P/ ACCOM ( 8) , M00144( 3) 00970002 COMMON /P/ ACUSER ( 5) , M00188( 52) 00980002 COMMON /P/ KPNA 00990002 COMMON /P/ KPRNO , M00420( 2) 01000002 COMMON /P/ KPDBGS 01010002 COMMON /P/ KPDBGA 01020002 COMMON /P/ KPDBGN , M00440( 7) 01030002 COMMON /P/ KPIRSM 01040002 COMMON /P/ KPNRSM 01050002 COMMON /P/ KPIUSM 01060002 COMMON /P/ KPNUSM , M00484( 10) 01070002 COMMON /P/ KPPRNT , M00528( 2) 01080002 COMMON /P/ KPBUGF , M00540 01090002 COMMON /P/ KPTRIO , M00548 01100002 COMMON /P/ KPVOLS , M00556( 2) 01110002 COMMON /P/ KPDSNS , M00568( 141) 01120002 COMMON /P/ MCCOLR , M01136( 40) 01130002 COMMON /P/ PTFATL , M01300( 34) 01140002 COMMON /P/ PROTAB ( 2) 01150002 COMMON /P/ ENDP 01160002 CRAY CHARACTER*4 AC64BC 01170002 C 01180002 COMMON /SYSTEM/ SYSTEM 01190002 CRAY COMMON /SYSTEM/ SYBYPW 01200008 CRAY COMMON /SYSTEM/ SYLOCF 01210008 C 01220002 COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN,THL 01230002 C 01231006 COMMON /GUNITS/ LU(20) 01232006 C 01240002 COMMON COM(1) 01250002 C 01260002 C INTEGER VARIABLES -- LOCAL 01261002 C 01270002 INTEGER DSTYP 01310002 INTEGER ERR 01340002 INTEGER ERRIN 01350002 INTEGER NREC 01360002 INTEGER PLTNO 01370002 C 01390002 C 01470002 C CHARACTER VARIABLES & ARRAYS -- LOCAL 01480002 C 01490002 CHARACTER*80 DCARD1 01520002 CHARACTER*80 CARD 01530002 CHARACTER*44 DSNAME 01540002 CHARACTER*8 DBGFN 01570002 CHARACTER*8 DDNAME 01580002 CHARACTER*8 PRESNT 01600002 CHARACTER*8 TMPDDN 01610002 CHARACTER*8 VOLSER ( 5) 01611002 CHARACTER*5 C3640 01620002 CHARACTER*5 C7680 01650002 CHARACTER*5 ONCOL 01660002 CHARACTER*5 OFCOL 01670002 CHARACTER*5 COL 01680002 CHARACTER*5 ONESP 01690002 CHARACTER*5 OFESP 01700002 CHARACTER*5 ESP 01710002 CHARACTER*5 META 01720002 CHARACTER*4 BLANK 01740002 CHARACTER*4 SYSTEM 01820002 C 01840002 C 01890002 DATA PRESNT / 'PRESENT '/ 01940002 DATA DBGFN / 'DBGXXX '/ 01950002 DATA ONCOL / 'ONCOL'/ 01980002 DATA OFCOL / 'OFCOL'/ 01990002 DATA COL / ' COL'/ 02000002 DATA ONESP / 'ONESP'/ 02010002 DATA OFESP / 'OFESP'/ 02020002 DATA ESP / ' ESP'/ 02030002 DATA META / ' META'/ 02051002 DATA BLANK / ' ' / 02060002 C 02140002 C 02150002 KPDSNS = 0 02160002 C 02161002 CRAY IF (SYSTEM .EQ. 'CRAY') GO TO 100 02170007 IPR = KPPRNT 02180002 02190006 LU (1) = KPPRNT 02191006 LU (11) = KPPRNT 02192006 02193006 DSTYP = 0 02200006 PLTNO = 0 02201006 NPLTDS = 0 02201106 RLSFLG = 1 02202006 KPDSNS = KPIUSM 02203006 NPLTDS = 0 02203106 COM (KPDSNS) = 0 02203202 C 02204002 DA = 1 02210002 CALL FORC( KPNA, KPRNO, DA, CARD, *1060) 02220002 DCARD1 = CARD 02230002 C7680 = CARD(76:80) 02240002 C3640 = CARD(36:40) 02250002 OUTFLG = 1 02251002 C 02260002 C CHECK FOR PLOT FILE TO BE WRITTEN WITH NO PLOT PRODUCED. DEFAULT 02262002 C TO MSS OUTPUT DATA SET. C7680 IS USED AS FLAG FOR TYPE OF DATA 02263002 C SET TO BE ALLOCATED. 02264002 C 02265002 IF ( C7680(1:5) .EQ. COL(1:5) ) OUTFLG = 0 02269002 IF ( C7680(1:5) .EQ. ESP(1:5) ) OUTFLG = 0 02269602 C 02269802 C 02269902 C 02270002 C -------------------------------------------------------------------- 02280002 C ALLOCATION FOR UNIRAS COLOR PLOT FILE 02460002 C 02470002 10 IF ( CARD(78:80) .EQ. COL(3:5) ) THEN 02480002 C 02481002 DSTYP = 4 02490002 NREC = 2700 02490102 C 02491002 CALL UPNPLT(NREC, DSTYP, RLSFLG, PLTNO, DSNAME, DDNAME, 02500002 + DYNAMF, ERR, ERRIN) 02510002 IF (ERR .GT. 1) THEN 02520002 GO TO 1070 02521002 ELSE 02522002 COM(KPDSNS) = COM(KPDSNS) + 1 02523002 NPLTDS = NPLTDS + 1 02523102 INDXKP = KPDSNS + 3*(NPLTDS-1) 02523202 COM( INDXKP + 1 ) = 0 02523302 CALL S1MVCH( DSNAME, 5, COM(INDXKP+2), 1, 8 ) 02523402 GO TO 100 02523502 END IF 02524002 C 02525002 END IF 02526002 C 02530002 C -------------------------------------------------------------------- 02777002 C ALLOCATION FOR ESP PLOT FILE 02860002 C 02870002 IF ( CARD(78:80) .EQ. ESP(3:5) ) THEN 02880002 C 02881002 DSTYP = 1 02890002 NREC = 5000 02900005 C 02920002 C DETERMINE PLOT SEQUENCE NUMBER BY FINDING NEXT AVAIABLE DDNAME OF 02921002 C THE FORM DBGXXX, WHERE XXX IS IN THE SEQUENCE 002, 004, 006, ... 02922002 C PLOT SEQUENCE NUMBER = XXX / 2 02922102 C 02923002 DBGNUM = 0 02924002 20 DBGNUM = DBGNUM + 2 02925002 CALL S1BNCV( DBGNUM, DBGFN , 4, 3) 02926002 TMPDDN = DBGFN 02927002 CALL CKDD(TMPDDN) 02928002 IF (TMPDDN .EQ. PRESNT) GO TO 20 02929002 PLTNO = DBGNUM / 2 02929102 C 02929202 CALL UPNPLT(NREC, DSTYP, RLSFLG, PLTNO, DSNAME, DDNAME, 03110002 + DYNAMF, ERR, ERRIN) 03111002 IF (ERR .GT. 1) THEN 03120002 GO TO 1070 03121002 ELSE 03122002 COM(KPDSNS) = COM(KPDSNS) + 1 03122102 NPLTDS = NPLTDS + 1 03122202 INDXKP = KPDSNS + 3*(NPLTDS-1) 03122302 COM( INDXKP + 1 ) = 0 03122402 CALL S1MVCH( DSNAME, 5, COM(INDXKP+2), 1, 8 ) 03122502 GO TO 100 03123002 END IF 03124002 C 03130002 END IF 03140002 C 03250002 C -------------------------------------------------------------------- 03650002 C ALLOCATION FOR UNIRAS META FILE 03651002 C 03652002 IF ( C7680 .EQ. META) THEN 03653002 NREC = 2700 03653103 DSTYP = 5 03653203 C 03653602 CALL UPNPLT(NREC, DSTYP, RLSFLG, PLTNO, DSNAME, DDNAME, 03653702 + DYNAMF, ERR, ERRIN) 03653802 IF (ERR .GT. 1) THEN 03653902 GO TO 1070 03654002 ELSE 03655002 COM(KPDSNS) = COM(KPDSNS) + 1 03655102 NPLTDS = NPLTDS + 1 03655202 INDXKP = KPDSNS + 3*(NPLTDS-1) 03655302 COM( INDXKP + 1 ) = 0 03655402 CALL S1MVCH( DSNAME, 5, COM(INDXKP+2), 1, 8 ) 03655502 GO TO 100 03655602 END IF 03655702 C 03655802 C 03655902 END IF 03656002 C 03656102 C -------------------------------------------------------------------- 03657002 C 03658002 C 03680002 100 IF ( DSTYP .NE. 0 ) THEN 03690002 C 03690102 IF (KPBUGF .GT. 0 ) WRITE(IPR,9000) KPNA, KPRNO, DSNAME 03691002 9000 FORMAT(/5X,'*** FOR SPARC DEVELOPMENT PROCESS ',A4,I1,' ***' /, 03700002 + 5X,'DYNAMICALLY ALLOCATED PLOT DATA SET NAME : ',A44 /) 03701002 C 03720002 C CONSTRUCT THE FILE ATTRIBUTE TABLE (FAT) INTO RESERVED COMMON. 03740002 C THE AREA IN COM INDEXED BY KPDSNS HAS BEEN BUILT (ABOVE) INTO 03741002 C THE 1ST 4*NPLTDS WORDS OF UNRESERVED COM. THIS NOW NEEDS TO BE 03742002 C RESERVED. 03743002 C THE FAT WILL BE PROCESSED FOR AUTO PLOT BY CSRECP (CALLED BY 03750002 C CSEXEC) AT END OF SPARC JOB. 03760002 C 03770002 INDFAT = KPIUSM + 4*NPLTDS 03780002 NOWDS = 4*NPLTDS + PTFATL 03781002 IF (PTFATL .LE. 0) NOWDS = 4*NPLTDS + 30 03790002 C 03792002 IF (KPNUSM .LT. NOWDS) GO TO 1080 03800002 C 03801002 CALL UPRESM(NOWDS) 03820002 C 03830002 CALL ARSET ( COM(INDFAT), 30, BLANK ) 03840002 C 03850002 KPTRIO = 1 03860002 KPDBGN = KPDBGN + 1 03870002 IF( KPDBGA .EQ. 0) KPDBGA = LOC( COM(INDFAT) ) 03880002 C 03890002 CALL S1MVCH( DDNAME,1, COM(INDFAT ),1, 8) 03900002 CALL S1MVCH( DSNAME,1, COM(INDFAT+ 2),1, 44) 03910002 CALL S1MVCH( UNITYP,1, COM(INDFAT+13),1, 8) 03920002 COM( INDFAT + 15 ) = 1 03930002 COM( INDFAT + 17 ) = 1 03940002 COM( INDFAT + 18 ) = TAPDEN 03950002 CALL USDDNV( DDNAME, VOLSER(1), VOLCNT, IER) 03960002 COM( INDFAT + 19 ) = 0 03970002 COM( INDFAT + 20 ) = VOLCNT 03980002 COM( INDFAT + 21 ) = LRECL 03990002 CALL S1MVCH( FILMOD,1, COM(INDFAT+23),1, 1) 04000002 IF (OUTFLG .EQ. 1) CALL S1MVCH( 'O ',1, COM(INDFAT+24),1, 4) 04010002 CALL S1MVCH( LCTYP, 1, COM(INDFAT+25),1, 4) 04020002 CALL S1MVCH( LCBGSP,1, COM(INDFAT+26),1, 4) 04030002 CALL S1MVCH( LCENSP,1, COM(INDFAT+27),1, 4) 04040002 CALL S1MVCH( DSFRMT,1, COM(INDFAT+29),1, 4) 04050002 C 04060002 LOCFAT = LOC( COM(INDFAT) ) 04070002 LOCPTB = LOC( PROTAB ) 04080002 IF (KPBUGF .EQ. 3) WRITE(IPR, 9911) KPDBGN, KPDBGA, KPDBGS, 04090002 + INDFAT, LOCFAT, LOCPTB, 04100002 + (COM(INDFAT+J-1), J= 1,15), (COM(INDFAT+I-1), I=16,30) 04110002 C 04120002 C 04120402 END IF 04121002 C 04130002 C 05010002 C RETURN LOGIC 05020002 C 05030002 C NORMAL RETURN ERR = 1 05040002 ERR = 1 05050002 C 05060002 1000 CONTINUE 05070002 RETURN 05080002 C 05090002 C ERROR 05100002 C 05110002 C 05210002 1060 ERR = 99 05220002 WRITE(KPPRNT, 9060) KPNA,KPRNO 05230002 9060 FORMAT(// 5X,'*** ERROR *** NO CARDS FOUND FOR PROCESS ',A4,I1) 05240002 GO TO 1000 05250002 C 05260002 1070 WRITE(KPPRNT, 9070) C7680, ERR, ERRIN 05270002 9070 FORMAT(// 5X,'*** ERROR *** DYNAMIC ALLOCATION FAILED FOR ',A6, 05280002 + ' PLOT DATA SET'/, 5X,' ERR = ',I5,' ERRIN = ',Z8) 05290002 GO TO 1000 05300002 C 05310002 1080 WRITE(KPPRNT, 9080) NOWDS 05528502 9080 FORMAT(// 5X,'*** ERROR *** NOT ENOUGH MEMORY FOR FAT '/ 05528602 + 5X,' NEED AT LEAST ANOTHER ',I4,' WORDS.') 05528702 GO TO 1000 05528802 C 05528902 9911 FORMAT(5X,'IN UGALPF : /KPDBGN/KPDBGA/KPDBGS/ ', 3I10/ 05586502 + 5X,' /INDFAT/LOCFAT/LOCPTB/ ', 3I10//, 05586602 + 5X,'FAT AFTER INIT IN UGALPF :'/, 5X,2A4,5X,11A4,2X,2A4/, 05586702 + 5X,8I9/, 5X,8(A4,2X) ) 05586802 C 05586902 C 05588002 END 05590002