CTITLE FOOASZ -- GLI FILE INFORMATION OPEN - STATICS/DATUMS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. S. HOGARTH 00020000 CA DESIGNER R. S. HOGARTH 00030000 CA LANGUAGE VS FORTRAN (77) 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 12-3-87 00060000 C REVISED 07-19-88 TJT - MODIFY FOR NEW GLI3D STATICS FORMAT. 00070000 C REVISED 11-07-88 RDK - CHANGE UPOPRM CALL TO UPSPRM. 00080000 C REVISED 09-29-89 ESN - CORRECT PRINT FORMAT OF SPDSN TO A8. 00090000 CA 00100000 CA 00110000 CA CALL FOOASZ( KPBUGF, IPR, FSP, LSP, NSHOT, NTR, SPDSN, 00120000 CA WORK, DBCAD, IST) 00130000 CA 00140000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00150000 CA 00160000 CA IN KPBUGF I DEBUG FLAG 00170000 CA IN IPR I DEBUG UNIT 00180000 CA OUT FSP I FIRST SHOT TO PROCESS IN FILE ORDER 00190000 CA OUT LSP I LAST SHOT TO PROCESS IN FILE ORDER 00200000 CA OUT NSHOT I NUMBER OF SHOTPOINTS PROCESSED 00210000 CA OUT NTR I NUMBER OF TRACES PER SHOTPOINT 00220000 CA IN SPDSN A8 SPARC DATA SET NUMBER (RIGHT JUSTIFIED) 00230000 CA IN/OUT WORK I WORK ARRAY. LENGTH = 2(NTR)+1 00240000 CA OUT DCBAD I DCB ADDRESS 00250000 CA OUT IST I ERROR FLAG 00260000 CA 0 FOR NO ERROR 00270000 CA 00280000 CA THIS SUBROUTINE ALLOCATES AND READS THE FIRST RECORD TO RETREIVE 00290000 CA THE SHOTPOINT RANGE. 00300000 CA 00310000 C***********************************************************************00320000 C 00330000 SUBROUTINE FOOASZ( KPBUGF, IPR, FSP, LSP, NSHOT, NTR, 00340000 . SPDSN, WORK, DCBAD, IST) 00350000 IMPLICIT INTEGER (A-Z) 00360000 C 00370000 INTEGER WORK(10) 00380000 INTEGER TYPE /1/ 00390000 CHARACTER*2 ACDIST 00400000 CHARACTER*8 SPDSN 00410000 CHARACTER*44 DSN /' '/ 00420000 CHARACTER*8 DDNAME 00430000 CHARACTER*4 CHAR 00440000 EQUIVALENCE (CHAR,ICHAR) 00450000 C 00460000 IST = 0 00470000 IF(1.EQ.2)CALL FGTRCE 00480000 C----------CATALOG/ALLOCATE 00490000 CALL UPSPRM(SPDSN,TYPE,DDNAME,DSN,DCBAD,ERR,ERIN) 00500000 IF(ERR.EQ.5)GO TO 9001 00510000 IF(ERR.NE.1)GO TO 9002 00520000 C----------OPEN DATA SET 00530000 CALL FGIRTR(DCBAD,BLKSIZ,STATUS) 00540000 IF(STATUS.NE.1)GO TO 9004 00550000 C----------READ HEADER BLOCK 00560000 CALL FGRTR(DCBAD,WORK,LRECL,STATUS) 00570000 IF(STATUS.NE.1) GO TO 9005 00580000 ICHAR = WORK(1) 00590000 IF(CHAR.NE.'GLIA') WRITE(IPR,8004)CHAR,WORK(1),BLKSIZ,LRECL 00600000 8004 FORMAT(' GLI FILE ID:',A4,Z10,' SHOULD BE GLIA. ','BLK,REC=',2I8) 00610000 FSP = WORK(2) 00620000 LSP = WORK(3) 00630000 NSHOT = WORK(4) 00640000 NTR = WORK(5) 00650000 IREC = (NTR * 2 + 3) * 4 00660000 IF(IREC .NE. LRECL) GO TO 9003 00670000 8999 CONTINUE 00680000 IF(KPBUGF.EQ.3) THEN 00690000 WRITE(IPR,8001)DSN 00700000 8001 FORMAT(' GLIA EXIT FOOASZ DSN:',A44) 00710000 WRITE(IPR,*)' WORK= ',(WORK(I),I=1,8) 00720000 ENDIF 00730000 C 00740000 RETURN 00750000 C------------------ERRORS----------------- 00760000 9001 CONTINUE 00770000 IST = 1 00780000 WRITE(IPR,9101) ACDIST,SPDSN,ERR,ERIN 00790000 9101 FORMAT(5X,'*** ERROR. DATA SET NOT FOUND:-', 00800000 . 1X,A2,1X,A8,/5X,'*** ERR ERIN FLAGS:-',2Z9) 00810000 GO TO 8999 00820000 9002 CONTINUE 00830000 IST = 2 00840000 WRITE(IPR,9102) ACDIST,SPDSN,ERR,ERIN 00850000 9102 FORMAT(5X,'*** ERROR. CATALOG SEARCH FOR DISTRICT, DSN:-', 00860000 . 1X,A2,1X,A8,/5X,'*** ERR ERIN FLAGS:-',2Z9) 00870000 GO TO 8999 00880000 9003 CONTINUE 00890000 IST = 3 00900000 WRITE(IPR,9103) DSN, LRECL, IREC 00910000 9103 FORMAT(5X,'*** ERROR--INPUT FILE IS NOT A GLI3D FILE ***',/, 00920000 . 5X,' DSN:',A44,/, 00930000 . 5X,' RECORD LENGTH IN BYTES OF FILE READ=',I10,/, 00940000 . 5X,' RECORD LENGTH IN BYTES SHOULD BE =',I10,/) 00950000 GO TO 8999 00960000 9004 CONTINUE 00970000 IST = 4 00980000 WRITE(IPR,9104) ACDIST,SPDSN,STATUS 00990000 9104 FORMAT(5X,'*** ERROR. OPEN FAILED FOR DISTRICT, DSN:-', 01000000 . 1X,A2,1X,A8,/5X,'*** STATUS FLAG:-',Z9) 01010000 GO TO 8999 01020000 9005 CONTINUE 01030000 IST = 5 01040000 WRITE(IPR,9105) ACDIST,SPDSN,STATUS 01050000 9105 FORMAT(5X,'*** ERROR. READ ERROR, 1ST REC FOR DISTRICT, DSN:-', 01060000 . 1X,A2,1X,A8,/5X,'*** STATUS FLAG:-',Z9) 01070000 GO TO 8999 01080000 END 01090000