CTITLE SACENDP -- COLOR (UNIRAS) DISPLAY TERMINATION C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR JOHN V. S. HARVEY CA LANGUAGE VS FORTRAN (77) CA SYSTEM IBM ONLY CA REWRITTEN 29 MAR 1988 C C REVISED 08-08-90 CLJ - CORRECT THE LOCATION IN THE FILE C ATTRIBUTE TABLE FOR OUTPUT PLOT C DATASET NUMBERS C REVISED 09-12-90 CLJ - CORRECT SETTING OF FLAG TO INDICATE C THAT A FILE WAS ADDED TO THE PLOT C QUEUE CA CA CA THIS SUBROUTINE WILL COMPLETES A UNIRAS COLOR PLOT (FOR SPARC) CA AND ADDS THE NEW OUTPUT DATASET TO THE PLOT QUEUE. CA CA CA **************************************************************** CA *** NOTE: THE FOLLOWING SUBROUTINES MUST BE CALLED FIRST: *** CA *** SACNEWP *** CA **************************************************************** CA CA CA CALL SACENDP( PLCODE, YMAX, PLTNUM, NUMPLT, DSNAME, CA PLTWRK, ERR1, ERR2 ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN PLCODE CH4 PLOTTER INITIALIZATION CODE CA 'META' = PC G/GX METAFILE CA 'VERC' = COLOR VERSATEC CA IN YMAX R4 MAXIMUM PLOTTING LIMIT (Y-AXIS) CA CA IN PLTNUM I4 PLOT SEQUENCE NUMBER (1 FOR FIRST PLOT) CA IN NUMPLT I4 TOTAL NUMBER OF PLOTS CA CA CA IN/OUT DSNAME CH44 NAME OF META-FILE ALLOCATED CA (IN: 'META' OPTION ONLY) CA (OUT: 'VERC' OPTION ONLY) CA CA WORK PLTWRK I2 WORK AREA (16384 HALFWORDS) CA CA CA OUT ERR1 I4 ERROR CODE. CA 1 = NO ERROR CA 2 = INVALID DATA SET TYPE (FIRST CARD COL 40) CA 3 = SEISTRAN FILE ACCESS FAILURE CA 4 = LINE NAME BLANK ON LINE CARD. CA 5 = LINE NAME CONTAINS EMBEDDED BLANKS. CA 6 = LINE NAME INVALID CA 7 = INVALID PLOTTER CODE (FIRST CARD COL 76) CA 8 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) CA 9 = SVC 99 INSTALLATION ERROR (SEE ERR2) CA 10 = SVC 99 PARAMETER ERROR (SEE ERR2) CA 11 = NOT USED CA 12 = DCB MEMORY ALLOCATION FAILURE CA 13 = NOT USED CA 14 = NOT USED CA 15 = DATA SET NAME ALL BLANKS. CA 16 = ZERO OR NEGATIVE NUMBER OF RECORDS CA 18 = INVALID BLOCKSIZE CA 19 = BLOCKSIZE/RECORD LENGTH MISMATCH CA 20 = BLOCKSIZE/RECORD LENGTH (SEISMIC). CA 21 = INVALID TYPE OF PLOT CA 22 = TSO USERID RETRIEVEL ERROR CA 23 = NO DATA CARDS FOR PROCESS. CA 24 = PLOTNO > KPDBGN & FAT'S EXIST. CA 25 = NOT USED CA 26 = OUTPUT TOO LARGE FOR INTERACTIVE CA 27 = INVALID RECORD COUNT CA 28 = INVALID BLOCKSIZE CA 29 = EXCESSIVE VOLUME COUNT CA CA 102 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) CA 103 = SVC 99 INSTALLATION ERROR (SEE ERR2) CA 104 = SVC 99 PARAMETER ERROR (SEE ERR2) CA 105 = ATTEMPT TO CLOSE DATA SET FAILED. CA 107 = DCB AREA NOT RELEASED BY FREEMAIN. CA 108 = DDNAME IN DCB IS ALL BLANKS. CA CA CA OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). CA BYTES 1 AND 2 = ERROR CODE, CA BYTES 3 AND 4 = INFORMATION CODE. CA CA SEE IBM MANUAL GC28-0627-2, OS/VS2 MVS CA SYSTEM PROGRAMMING LIBRARY: CA JOB MANAGEMENT, PAGES 28 TO 31.0. CA CA********************************************************************** CA CA COMMON BLOCKS USED: / P / -- SPARC REFERENCE PARAMETERS CA CA KPDSNS MUST BE INITIALIZED CA -- PREFERRABLY TO KPIUSM -- CA BEFORE FIRST CALL TO SACNEWP CA CA CA / / -- SPARC APPLICATION COMMON CA CA KPDSNS WILL POINT INTO THIS CA COMMON BLOCK TO A REGION WITH CA A SIZE OF: CA 2*NUMPLT + 2 CA CA WHERE NUMPLT IS THE NUMBER OF CA OUTPUT DATASETS CAEND C*********************************************************************** C C SUBROUTINES CALLED: GCHARA -- UNIRAS CHARACTER PLOTTING ANGLE C GCHAR -- UNIRAS CHARACTER STRING PLOTTING C C GSEGCL -- UNIRAS SEGMENT CLOSE C GCLOSE -- UNIRAS CLOSE C QHVERC -- UNIRAS VERSATEC CLOSE (HOST) C C UPNPLT -- ALLOCATE NEW PLOT FILE C UGUNAL -- DEALLOCATE NEW PLOT FILE C UPAPLT -- ADD PLOT TO PLOT QUEUE C C S1MVCH -- MOVE CHARACTERS C C*********************************************************************** C SUBROUTINE SACENDP( PLCODE, YMAX, PLTNUM, NUMPLT, DSNAME, * PLTWRK, ERR1, ERR2 ) IMPLICIT INTEGER (A-Z) C CHARACTER*4 PLCODE CHARACTER*44 DSNAME REAL YMAX C INTEGER*2 PLTWRK(16384) C====================================================================== C C COMMON /P/ STATEMENTS GENERATED BY J.V.S.HARVEY 9/1/87 C CHARACTER*8 STARTP CHARACTER*20 ACLNAM CHARACTER*32 ACCOM CHARACTER*20 ACUSER REAL ACNMIP C COMMON /P/ STARTP COMMON /P/ LCNAME COMMON /P/ LC5 COMMON /P/ LCINT COMMON /P/ LCTYP COMMON /P/ LC10 COMMON /P/ LCBGSP COMMON /P/ LCENSP COMMON /P/ LC2130(2) COMMON /P/ LCNSP COMMON /P/ LCTPSP COMMON /P/ LCRL COMMON /P/ LCSI COMMON /P/ LCPI COMMON /P/ LCGRPI COMMON /P/ LCMXFD COMMON /P/ LCANSP COMMON /P/ LCMXLN COMMON /P/ LCDRYF COMMON /P/ LCWD20(3) COMMON /P/ ACNAME COMMON /P/ AC0506 COMMON /P/ AC64BC COMMON /P/ ACOPCD COMMON /P/ ACQCF COMMON /P/ ACDIST COMMON /P/ ACPROJ COMMON /P/ ACLNAM COMMON /P/ ACCOM COMMON /P/ AC7274 COMMON /P/ ACTYPE COMMON /P/ ACNSP COMMON /P/ ACUSER COMMON /P/ ACNMIP COMMON /P/ ACNTRP COMMON /P/ ACNTRW COMMON /P/ ACNCDP COMMON /P/ ACMIGR COMMON /P/ ACQUAD COMMON /P/ ACSLOG COMMON /P/ ACVELA COMMON /P/ ACDDEC COMMON /P/ ACWD38(3) COMMON /P/ LHJBNO COMMON /P/ LHLNO COMMON /P/ LHRLNO COMMON /P/ LHTPSP COMMON /P/ LHATSP COMMON /P/ LHSI COMMON /P/ LHORSI COMMON /P/ LHST COMMON /P/ LHORST COMMON /P/ LHDFCD COMMON /P/ LHEXFD COMMON /P/ LHTSCD COMMON /P/ LHVSCD COMMON /P/ LHSWFS COMMON /P/ LHSWFE COMMON /P/ LHSWL COMMON /P/ LHSWCD COMMON /P/ LHTSNO COMMON /P/ LHSWTS COMMON /P/ LHSWTE COMMON /P/ LHSWTT COMMON /P/ LHTCF COMMON /P/ LHBGRF COMMON /P/ LHARCD COMMON /P/ LHMS COMMON /P/ LHSGPL COMMON /P/ LHVPCD COMMON /P/ LHNSP COMMON /P/ LHNDP COMMON /P/ LHNSL COMMON /P/ LHMTPR COMMON /P/ LHWD32(9) COMMON /P/ KPNA COMMON /P/ KPRNO COMMON /P/ KPOCUR COMMON /P/ KPA COMMON /P/ KPDBGS COMMON /P/ KPDBGA COMMON /P/ KPDBGN COMMON /P/ KPWRKS COMMON /P/ KPWRKD COMMON /P/ KPWKS2 COMMON /P/ KPWKD2 COMMON /P/ KPWKS3 COMMON /P/ KPWKD3 COMMON /P/ KPFCF COMMON /P/ KPIRSM COMMON /P/ KPNRSM COMMON /P/ KPIUSM COMMON /P/ KPNUSM COMMON /P/ KPTIME COMMON /P/ KPRTF COMMON /P/ KPDRTF COMMON /P/ KPMOTF COMMON /P/ KPNBR COMMON /P/ KPIBN COMMON /P/ KPITSV COMMON /P/ KPTAMF COMMON /P/ KPLOTF COMMON /P/ KPMITF COMMON /P/ KPPRNT COMMON /P/ KPPLOT COMMON /P/ KPPLTA COMMON /P/ KPBUGF COMMON /P/ KPWARN COMMON /P/ KPTRIO COMMON /P/ KPWKIO COMMON /P/ KPVOLS COMMON /P/ KPWTSF COMMON /P/ KPETIM COMMON /P/ KPDSNS COMMON /P/ ZZZZZX(141) COMMON /P/ MCCOLR COMMON /P/ ZZZZZY(40) COMMON /P/ PTFATL COMMON /P/ ZZZZZZ(34) COMMON /P/ PROTAB (2) COMMON /P/ ENDP C ------------------------------------------- C C BLANK COMMON C COMMON ICOM(1) C====================================================================== C C LOCAL REAL VARIABLES AND CONSTANTS C REAL HT010 PARAMETER ( HT010 = 2.540 ) C REAL Y C---------------------------------------------------------------------- C C CHARACTER VARIABLES & ARRAYS -- LOCAL C CHARACTER*45 TEXT CHARACTER*14 PLTLAB / 'PLOT 00 OF 00$' / CHARACTER*8 DDNAME C C*********************************************************************** C*** **** C*** VERSATEC PLOT FILE ALLOCATION **** C*** **** C*********************************************************************** C C UPNPLT CREATES A NEW, PERMANENT, CATALOGUED PLOT DATSET AND C WRITES A RECORD FOR THE SMS SYSTEM FOR EACH OUTPUT DATASET. C C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN NREC I4 NUMBER OF RECORDS IN DATA SET. C C IN PLTYPE I4 TYPE OF PLOT DATASET TO BE ALLOCATED: C 4 = UNIRAS C 5 = UNIRAS METAFILE C C IN RLSEF I4 RELEASE FLAG TO INDICATE RLSE ATTRIBUTE C 1 = RELEASE SPACE AT CLOSE C 2 = DO NOT RELEASE SPACE AT CLOSE C C IN PLTNUM I4 SEQUENCE NUMBER OF PLOT BEING ALLOCATED. C SHOULD START AT 1 AND INCREMENT FOR EACH C NEW PLOT DATA SET. USED TO INDEX INTO C ANY EXISTING FILE ATTRIBUTE TABLE. C C OUT DSNAME CH44 NAME OF SEQUENTIAL DATA SET ALLOCATED C C OUT DDNAME CH8 DDNAME OF OUTPUT DATASET. C C OUT DYNAMF I4 DYNAMIC ALLOCATION FLAG C 0 = NO DYNAMIC ALLOCATION C 1 = DATA SET WAS DYNAMICALLY ALLOCATED C C OUT ERR1 I4 ERROR CODE. C 1 = OK. C 2 = INVALID DATA SET TYPE CODE IN C COL 40 OF CARD. C 3 = COULD NOT OPEN SEISTRAN FILE C TO GET DATA SET NUMBER. C 4 = LINE NAME BLANK ON LINE CARD. C 5 = LINE NAME CONTAINS EMBEDDED BLANKS. C 6 = LINE NAME 8 CHARACTERS LONG AND C FIRST CHARACTER NOT ALPHABETIC. C 7 = INVALID CODE IN LAST FIELD OF CARD, C COLS. 76-80 OR 78-80. VALID CODES C ARE ESP, COL, OFTAD, AND BLANK. C 8 <---4 ) RETURN CODES C 9 <---8 ) FROM SVC 99. C 10 <--12 ) SEE IBM MANUAL BELOW, P. 27. C 11 = NOT USED (CLOSE FAILED). C 12 = GETMAIN (FOR DCB AREA) FAILED. C 13 = NOT USED (FREEMAIN FAILED). C 14 = NOT USED (DDNAME ALL BLANKS). C 15 = DATA SET NAME ALL BLANKS. C 16 = NREC ZERO OR NEGATIVE. C 18 = BLKSIZ ZERO OR NEGATIVE, OR > 32760. C 19 = BLKSIZ NOT A MULTIPLE OF LRECL. C 20 = BLKSIZ NOT EQUAL TO LRECL (SEISMIC). C 21 = PLTYPE NOT 1, 2, 3, OR 4. C 22 = TSO USERID RETRIEVEL ERROR. C 23 = NO DATA CARDS FOR PROCESS. C 24 = PLOTNO > KPDBGN & FAT'S EXIST. C 25 = NOT USED C 26 = OUTPUT TOO LARGE FOR INTERACTIVE C 27 = INVALID RECORD COUNT C 28 = INVALID BLOCKSIZE C 29 = EXCESSIVE VOLUME COUNT C C OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). C BYTES 1 AND 2 = ERROR CODE, C BYTES 3 AND 4 = INFORMATION CODE. C IBM MANUAL GC28-0627-2, OS/VS2 MVS C SYSTEM PROGRAMMING LIBRARY: C JOB MANAGEMENT, PAGES 28 TO 31.0. C C WRITE (KPPRNT,*)'***PLT***',ICOM(KPDSNS),ICOM(KPDSNS+1), * ICOM(KPDSNS+2),ICOM(KPDSNS+3) IF( PLCODE .EQ. 'VERC' ) * CALL UPNPLT( 2700, 4, 1, PLTNUM, DSNAME, DDNAME, * DYNAMF, ERR1, ERR2 ) C ------------------------------------------- C C UPDATE FILE ATTRIBUTE TABLE C IF( ERR1 .EQ. 1 ) THEN IF( PLTNUM .EQ. 1 ) THEN ICOM(KPDSNS) = 1 ICOM(KPDSNS+1) = 0 C CALL S1MVCH( DSNAME, 5, ICOM(KPDSNS+2), 1, 8 ) C ELSE PLTCNT = ICOM(KPDSNS) + 1 ICOM(KPDSNS) = PLTCNT C CCLJ-REMOVEDINDPLT = KPDSNS + 3*( PLTCNT - 1 ) + 1-REMOVED C INDPLT = KPDSNS + 2*( PLTCNT ) C CALL S1MVCH( DSNAME, 5, ICOM(INDPLT), 1, 8 ) ENDIF C C*********************************************************************** C*** **** C*** PLOT DATASET INFORMATION **** C*** **** C*********************************************************************** C C PLOTTED DATASET NAME C TEXT( 1:44) = DSNAME(1:44) TEXT(45:45) = '$' CALL GSCAMM C Y = 0.5*YMAX - 2.0 C CALL GCHARA( 90 ) CALL GCHAR( TEXT, 0.15*25.4, Y*25.4, HT010 ) C ------------------------------------------- C C NOTE PLOT SEQUENCE C WRITE( PLTLAB, 8000 ) PLTNUM, NUMPLT C Y = YMAX - 2.0 C CALL GCHARA( 90 ) CALL GCHAR( PLTLAB, 0.15*25.4, Y*25.4, HT010 ) C C*********************************************************************** C*** **** C*** CLOSE UNIRAS **** C*** **** C*********************************************************************** C IF( PLCODE .EQ. 'META' ) THEN CALL GSEGCL( 1 ) CALL GCLOSE C ELSE IF( PLCODE .EQ. 'VERC' ) THEN CALL QHVERC C C*********************************************************************** C*** **** C*** DEALLOCATION OF PLOT DATASET **** C*** **** C*********************************************************************** C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN KPDBGS I4 ADDRESS OF DATA CONTROL BLOCK OF C DATA SET TO BE UNALLOCATED. THE DCB C AREA, PREVIOUSLY OBTAINED BY A GETMAIN, C WILL BE RELEASED. THIS AREA MUST INCLUDE C TWO CONTROL WORDS IN FRONT OF THE DCB. C WORD ONE CONTAINS THE LENGTH OF THE AREA, C INCLUDING THE CONTROL WORDS. C WORD TWO IS NOT USED (5-31-82). C C OUT ERR1 I4 ERROR CODE. C 1 = OK. C 2 <---4 ) RETURN CODE C 3 <---8 ) FROM SVC 99. C 4 <--12 ) SEE IBM MANUAL BELOW, P. 27. C 5 = ATTEMPT TO CLOSE DATA SET FAILED. C 7 = DCB AREA NOT RELEASED BY FREEMAIN. C 8 = DDNAME IN DCB IS ALL BLANKS. C C OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). C BYTES 1 AND 2 = ERROR CODE, C BYTES 3 AND 4 = INFORMATION CODE. C IBM MANUAL GC28-0627-2, OS/VS2 MVS C SYSTEM PROGRAMMING LIBRARY: C JOB MANAGEMENT, PAGES 28 TO 31.0. C C CALL UGUNAL( KPDBGS, ERR1, ERR2 ) C IF( ERR1 .NE. 1 ) THEN ERR1 = ERR1 + 100 C C*********************************************************************** C*** **** C*** ADD PLOT TO PLOT QUEUE **** C*** **** C*********************************************************************** C C IN/OUT ARGUMENT TYPE DESCRIPTION C C WORK PLTWRK I2 WORK AREA (16384 HALFWORDS) C IN DSNAME CH44 DATASET NAME C * DUMY * C ELSE CALL UPAPLT( PLTWRK, DSNAME, DUMY ) C NUMPLT = ICOM(KPDSNS) C CCLJ-REMOVED INDPLT = KPDSNS + 3*( NUMPLT - 1 ) + 1-REMOVED CCLJ-REMOVED ICOM(INDPLT) = 1 -REMOVED C C SET FLAG INDICATING PLOT ADDED TO QUEUE ICOM(KPDSNS+1) = 1 ENDIF C KPDBGN = 0 KPDBGA = 0 ENDIF ENDIF RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENT **** C*** **** C*********************************************************************** C 8000 FORMAT('PLOT ',I2,' OF ',I2,'$') END