CTITLEFOTPOP -- TIME-PICK FILE ALLOCATION, OPEN, AND INTIAL READ 00000101 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. V. S. HARVEY 00000200 CA DESIGNER J. V. S. HARVEY 00000300 CA LANGUAGE VS FORTRAN (77) 00000400 CA SYSTEM IBM (SEE CRAY) 00000500 CA WRITTEN MAY 1985 00000600 C REVISED 11-20-85 ESN. RENAME FROM ZZTPOP AND 00000700 C RELEASE TO PRODUCTION. 00000800 CA 00000900 CA 00001000 CA THIS SUBROUTINE OPENS THEN TIME PICK FILE AND RETRIEVES 00001100 CA INFORMATION NECESSARY FOR SPACE ALLOCATION FOR FOTPRD 00001200 CA 00001300 CA 00001400 CA CALL FOTPOP( LCTPSP, TPFDSN, TPTYPE, TPFDD, TPDCB, 00001500 CA NSHOTP, BEGSP, ENDSP, ERR1, ERR2 ) 00001600 CA 00001700 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00001800 CA 00001900 CA IN LCTPSP I4 NUMBER OF TRACES PER SHOT 00002000 CA IN TPFDSN C8 CHAR REPRESENTATION OF DSN (RIGHT JUST) 00002100 CA IN TPTYPE I4 DATASET TYPE (1 FOR MASS STORAGE) 00002200 CA IN/OUT TPFDD C8 DD NAME (LEFT JUST) 00002300 CA OUT TPDCB I4 DCB ADDRESS OF TIME PICK FILE 00002400 CA OUT NSHOTP I4 NUMBER OF SHOT POINTS PICKED 00002500 CA OUT BEGSP I4 LOWEST SHOT POINT NUMBER PICKED 00002600 CA OUT ENDSP I4 HIGHEST SHOT POINT NUMBER PICKED 00002700 CA OUT ERR1 I4 ERROR FLAG: 00002800 CA -N FOR ERROR DURING ALLOCATION 00002900 CA -9 BLANK NAME 00003000 CA -8 TEMPORARY DATASET FAIL 00003100 CA -7 MULTIPLE ENTRIES 00003200 CA -5 NAME NOT FOUND 00003300 CA -6 GETMAIN FOR DCB 00003400 CA -4 SYSTEM ERROR -- SEE ERR2 00003500 CA -3 SVC 99 ERROR -- SEE ERR2 00003600 CA -2 DYNAMIC ALLOCATION FAILURE 00003700 CA -1 OPEN FAILURE 00003800 CA 0 FOR NO ERROR 00003900 CA 1 READ ERROR 00004000 CA 2 INVALID NUMBER OF PICKED SHOTS 00004100 CA 3 INVALID BEGINNING SHOT NUMBER 00004200 CA 4 INVALID ENDING SHOT NUMBER 00004300 CA 5 INVALID NUMBER OF TRACES PER SHOT00004400 CA OUT ERR2 I4 SECONDARY ERROR FLAG 00004500 CA 00004600 C***********************************************************************00004700 C 00004800 SUBROUTINE FOTPOP( LCTPSP, TPFDSN, TPTYPE, TPFDD, TPDCB, 00004900 * NSHOTP, BEGSP, ENDSP, ERR1, ERR2 ) 00005000 IMPLICIT INTEGER (A-Z) 00005100 C 00005200 CHARACTER*8 TPFDSN 00005300 CHARACTER*8 TPFDD 00005400 CHARACTER*44 TPFDS 00005500 C 00005600 CHARACTER*80 CARD 00005700 C 00005800 C DUMMY LINE TO RESOLVE MULTIPLE ENTRIES 00005900 C 00006000 IF( 1 .EQ. 2 ) CALL FGTRCE 00006100 C====================================================================== 00006200 C 00006300 C PAD DATASET NUMBER LEFT SIDE WITH CHAR. ZEROS 00006400 C 00006500 DO 10 I = 1, 8 00006600 IF( TPFDSN(I:I) .EQ. ' ' ) TPFDSN(I:I) ='0' 00006700 10 CONTINUE 00006800 C---------------------------------------------------------------------- 00006900 C 00007000 C ALLOCATE TIME-PICK FILE 00007100 C 00007200 C IN/OUT ARGUMENT TYPE DESCRIPTION 00007300 C 00007400 C IN TPFDSN C8 CHAR REPRESENTATION OF DSN (RIGHT JUST) 00007500 C IN TPTYPE I4 DATASET TYPE (1 FOR MASS STORAGE) 00007600 C IN/OUT TPFDD C8 DD NAME (LEFT JUST) 00007700 C OUT DSNAME C44 SEQ MASS STORAGE DATASET 00007800 C OUT TPDCB I4 DCB ADDRESS 00007900 C OUT ERR1 I4 ERROR CODE 00008000 C 1 FOR NO ERROR 00008100 C 2 DYNAMIC ALLOCATION FAILURE 00008200 C 3 SEE ERR2 (SVC 99) 00008300 C 4 SEE ERR2 (OTHER IBM ERROR) 00008400 C 5 NAME NOT FOUND 00008500 C 6 GETMAIN FOR DCB 00008600 C 7 MULTIPLE ENTRIES 00008700 C 8 TEMPORARY DATASET WRITE 00008800 C 9 BLANK NAME 00008900 C OUT ERR2 I4 DYNAMIC ALLOC CODES (SVC 99) 00009000 C 00009100 CALL UPOPRM( TPFDSN, TPTYPE, TPFDD, TPFDS, TPDCB, ERR1, ERR2 ) 00009200 ERR1 = -ERR1 00009300 IF( ERR1 .LT. -1 ) GOTO 900 00009400 C---------------------------------------------------------------------- 00009500 C 00009600 C OPEN THE TIME-PICK FILE FOR INPUT 00009700 C 00009800 C IN/OUT ARGUMENT TYPE DESCRIPTION 00009900 C 00010000 C IN TPDCB I4 DCB ADDRESS 00010100 C OUT BLKSIZ I4 MAX BLOCKSIZE IN BYTES 00010200 C OUT ERR1 I4 STATUS CODE (1=OK, 2=FAIL) 00010300 C 00010400 CALL FGIRTR( TPDCB, BLKSIZ, ERR1 ) 00010500 ERR1 = 1 - ERR1 00010600 ERR2 = 0 00010700 IF( ERR1 .NE. 0 ) GOTO 900 00010800 C---------------------------------------------------------------------- 00010900 C 00011000 C READ THE FIRST DATA RECORD (CARD 2) 00011100 C 00011200 C IN/OUT ARGUMENT TYPE DESCRIPTION 00011300 C 00011400 C IN TPDCB I4 DCB ADDRESS 00011500 C OUT CARD * DATA RECORD 00011600 C OUT LRECL I4 RECORD LENGTH 00011700 C OUT ERR1 I4 STATUS CODE (1=OK, >1=FAIL) 00011800 C 00011900 ERR1 = 1 00012000 CALL FGRTR( TPDCB, CARD, LRECL, ERR2 ) 00012100 IF( ERR2 .NE. 1 ) GOTO 900 00012200 C 00012300 C NUMBER OF SHOTPOINTS PICKED 00012400 C 00012500 ERR1 = 2 00012600 IF( CARD(1:5) .NE. ' ' ) THEN 00012700 READ( CARD(1:5), 7000, ERR=900 ) NSHOTP 00012800 C 00012900 C INITIAL SHOTPOINT NUMBER 00013000 C 00013100 ERR1 = 3 00013200 IF( CARD(6:10) .NE. ' ' ) THEN 00013300 READ( CARD(6:10), 7000, ERR=900 ) BEGSP 00013400 C 00013500 C ENDING SHOTPOINT NUMBER 00013600 C 00013700 ERR1 = 4 00013800 IF( CARD(11:15) .NE. ' ' ) THEN 00013900 READ( CARD(11:15), 7000, ERR=900 ) ENDSP 00014000 C 00014100 C MAXIMUM TRACES PER SHOTPOINT PICKED 00014200 C 00014300 ERR1 = 5 00014400 IF( CARD(16:20) .NE. ' ' ) THEN 00014500 READ( CARD(16:20), 7000, ERR=900 ) NTPSP 00014600 IF( NTPSP .LE. LCTPSP ) ERR1 = 0 00014700 ENDIF 00014800 ENDIF 00014900 ENDIF 00015000 ENDIF 00015100 C---------------------------------------------------------------------- 00015200 C 00015300 C EXIT 00015400 C 00015500 900 RETURN 00015600 C====================================================================== 00015700 C 00015800 C FORMAT STATEMENT 00015900 C 00016000 7000 FORMAT(I5) 00016100 END 00016200