CTITLEJSFF3D - JOBGEN REGION & BLANK COMMMON ALGORITHM FOR FF3D 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR W. R. FIELDER 00020000 CA DESIGNER W. R. FIELDER 00030000 CA LANGUAGE FORTRAN 77 00040000 CA SYSTEM IBM/CRAY 00050000 CA WRITTEN 02-14-92 00060000 C REVISED 08-18-92 DC/ESN. INCORPORATE PS2 CARD FOR 10 COLUMN 00070000 C VELOCITY INPUT. 00080000 CA 00090000 CA CALL JSFF3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, 00100000 CA ERCODE) 00110000 CA 00120000 CA INPUT KPNA = PROCESS NAME A4 00130000 CA INPUT KPRNO = PROCESS NUMBER I4 00140000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 00150000 CA KPRNO 00160000 CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 00170000 CA OUTPUT CSIZE = RESERVED BLANK COMMON SIZE IN WORDS I4 00180000 CA OUTPUT UCSIZE = UNRESERVED BLANK COMMON SIZE IN WORDS I4 00190000 CA OUTPUT ERCODE = ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 00200000 CA THE REQUIRED PARAMETERS) 00210000 CA 00220000 CA 00230000 CA COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON 00240000 CA (CSIZE) NEEDED BY SPARC DEVELOPMENT PROCESS 'NAME'. 00250000 CA JSFF3D IS AN EXTENSION OF SUBROUTINE JSRND. 00260000 C 00270000 C 00280000 CA EJECT 00290000 CAEND 00300000 C 00310000 SUBROUTINE JSFF3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, 00320000 + ERCODE) 00330000 C 00340000 IMPLICIT INTEGER (A-Z) 00350000 C 00360000 C NXTAB - MAXIMUM NUMBER OF OFFSET COMPONENTS 00370000 C THAT CAN BE HANDLED. 00380000 C 00390000 PARAMETER (NXTAB = 500) 00400000 C 00410000 C 00420000 CHARACTER*4 KPNA 00430000 CHARACTER*5 BLNK 00440000 CHARACTER*80 CARD 00450000 C 00460000 C INTEGER CONSTANTS -- LOCAL 00470000 C 00480000 INTEGER IPR 00490000 INTEGER THL 00500000 C 00510000 C REAL VARIABLES -- LOCAL 00520000 C 00530000 REAL DELF 00540000 C 00550000 DATA IPR / 98 / 00560000 DATA THL / 190 / 00570000 DATA BLNK /' '/ 00580000 C 00590000 C 00600000 C ==================================================== 00610000 C BEGIN COMPUTATION OF REGION AND COMMON SIZE FOR FF3D 00620000 C (INSERT REGION SIZE & BLANK COMMON SIZE CALCULATIONS HERE) 00630000 C =========================================== 00640000 C 00650000 C 00660000 C PART 1. SET PROGRAM SIZE IN K-BYTES (PSIZE) 00670000 C 00680000 C 00690000 PSIZE = 100 00700000 C 00710000 C GET LINE CARD PARAMETERS 00720000 C 00730000 DA = 1 00740000 CALL FORC ('LINE', 0, DA, CARD, * 9200 )00750000 C 00760000 LCTPSP = S1CVBN (CARD, 36, 5) 00770000 LCMXFD = S1CVBN (CARD, 61, 5) 00780000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 00790000 C 00800000 LCRLEN = S1CVBN (CARD, 41, 5) 00810000 LCSI = S1CVBN (CARD, 46, 5) 00820000 LCPI = S1CVBN (CARD, 51, 5) 00830000 IF (LCPI .EQ. 0) LCPI = LCSI 00840000 C 00850000 NOSAMP = LCRLEN / LCPI 00860000 LEN = THL + NOSAMP 00870000 C 00880000 9000 FORMAT (I5) 00890000 C 00900000 C=======================================================================00910000 C ONLY ONE PROCESSING RANGE IS PERMITTED 00920000 C=======================================================================00930000 C 00940000 C***********************************************************************00950000 C 00960000 C SET THE PROCESSING MODE 00970000 C 00980000 C***********************************************************************00990000 C 01000000 DAC = 1 01010000 100 CONTINUE 01020000 CALL FORC ( KPNA, KPRNO, DAC, CARD, *140 ) 01030000 IF (CARD(8:10) .NE. ' ') GO TO 100 01040000 C 01050000 IF (CARD(7:7) .EQ. 'S') THEN 01060000 C 01070000 MODE = 0 01080000 C 01090000 ELSE IF (CARD(7:7) .EQ. 'D') THEN 01100000 C 01110000 MODE = 1 01120000 C 01130000 ELSE IF (CARD(7:7) .EQ. 'F') THEN 01140000 C 01150000 MODE = 2 01160000 C 01170000 ENDIF 01180000 C 01190000 C SET UP MAXIMUM TRACES PER GATHER 01200000 C 01210000 IF (MODE .EQ. 0 .OR. MODE .EQ. 2) MTRC = LCTPSP 01220000 IF (MODE .EQ. 1) MTRC = LCMXFD 01230000 C 01240000 140 CONTINUE 01250000 C 01260000 C=======================================================================01270000 C 01280000 C *************************************************** 01290000 C ****** RETRIEVE PROCESSING PARAMETERS ****** 01300000 C *************************************************** 01310000 C 01320000 C#######################################################################01330000 C 01340000 C=======================================================================01350000 C 01360000 C NOW READ THE 'REJ' FILTER CARD IF INPUT 01370000 C 01380000 C=======================================================================01390000 C 01400000 C SEARCH FOR 'REJ' CARDS 01410000 C 01420000 DAR = 1 01430000 C 01440000 180 CONTINUE 01450000 CALL FORC ( KPNA, KPRNO, DAR, CARD, *200 ) 01460000 C 01470000 IF (CARD(8:10) .NE. 'REJ') GO TO 180 01480000 C 01490000 GO TO 260 01500000 C 01510000 200 CONTINUE 01520000 C 01530000 C=======================================================================01540000 C 01550000 C NOW READ THE 'PAS' CARD IF INPUT 01560000 C 01570000 C=======================================================================01580000 C 01590000 C SEARCH FOR 'PAS' CARDS 01600000 C 01610000 DAP = 1 01620000 C 01630000 220 CONTINUE 01640000 CALL FORC ( KPNA, KPRNO, DAP, CARD, *240 ) 01650000 C 01660000 IF (CARD(8:10) .NE. 'PAS') GO TO 220 01670000 C 01680000 GO TO 260 01690000 C 01700000 240 CONTINUE 01710000 C 01720000 C=======================================================================01730000 C 01740000 C NOW READ THE 'PS2' CARD IF INPUT 01750000 C 01760000 C=======================================================================01770000 C 01780000 C SEARCH FOR 'PS2' CARDS 01790000 C 01800000 DAP = 1 01810000 C 01820000 250 CONTINUE 01830000 CALL FORC ( KPNA, KPRNO, DAP, CARD, *255 ) 01840000 C 01850000 IF (CARD(8:10) .NE. 'PS2') GO TO 250 01860000 C 01870000 GO TO 260 01880000 C 01890000 255 CONTINUE 01900000 C 01910000 C ERROR HAS OCCURRED: NEITHER A 'REJ' NOR 'PAS' CARD WAS INPUT 01920000 C 01930000 WRITE (IPR, *) 'PROCESS NEEDS EITHER A REJ OR PAS DATA CARD' 01940000 ERCODE = 16 01950000 GO TO 9500 01960000 C 01970000 260 CONTINUE 01980000 C 01990000 C-----------------------------------------------------------------------02000000 C 02010000 C READ THE LOW-CUT FREQUENCY IN HZ 02020000 C 02030000 C-----------------------------------------------------------------------02040000 C 02050000 READ ( CARD(21:25), 9000 ) F1 02060000 C 02070000 C-----------------------------------------------------------------------02080000 C 02090000 C READ THE HIGH-PASS FREQUENCY IN HZ 02100000 C 02110000 C-----------------------------------------------------------------------02120000 C 02130000 C IF BLANK SET DEFAULT TO NYQUIST 02140000 C 02150000 IF (CARD(31:35) .EQ. BLNK) THEN 02160000 C 02170000 F3 = 500.0 / FLOAT ( LCPI ) 02180000 C 02190000 ELSE 02200000 C 02210000 READ ( CARD(31:35), 9000 ) F3 02220000 C 02230000 ENDIF 02240000 C 02250000 C-----------------------------------------------------------------------02260000 C 02270000 C READ THE HIGH-CUT FREQUENCY IN HZ 02280000 C 02290000 C-----------------------------------------------------------------------02300000 C 02310000 C IF BLANK SET DEFAULT TO HIGH-PASS FREQUENCY 02320000 C 02330000 IF (CARD(36:40) .EQ. BLNK) THEN 02340000 C 02350000 F4 = F3 02360000 C 02370000 ELSE 02380000 C 02390000 READ ( CARD(36:40), 9000 ) F4 02400000 C 02410000 ENDIF 02420000 C 02430000 C=======================================================================02440000 C 02450000 C SET UP FOR PROCESSING 02460000 C 02470000 300 CONTINUE 02480000 C 02490000 C DETERMINE THE POWER OF TWO FOR FFT 02500000 C 02510000 M = 5 02520000 N = 32 02530000 320 CONTINUE 02540000 M = M + 1 02550000 N = 2 * N 02560000 IF (N .LT. NOSAMP) GO TO 320 02570000 C 02580000 DELF = 1000. / ( FLOAT(N * LCPI)) 02590000 C 02600000 C CONVERT FREQUENCY RANGE TO RADIANS PER SEC 02610000 C 02620000 IF1 = F1 / DELF + 1 02630000 IF4 = F4 / DELF + 1 02640000 NF = IF4 - IF1 + 1 02650000 C 02660000 C=======================================================================02670000 C 02680000 C***********************************************************************02690000 C 02700000 C PART 2. COMPUTE RESERVED BLANK COMMON SIZE IN WORDS (ICC) 02710000 C 02720000 C THIS VALUE, FOR MOST CASES, IS IDENTICAL TO THE COMPUTATION OF 02730000 C RESERVED BLANK COMMON IN THE INITIALIZATION PART OF THE PROCESS 02740000 C (THE '0 ENTRY' FOR SPARC 'SHELLS'). THIS VALUE IS TYPICALLY 02750000 C CALLED 'ICC' AND IS THE TOTAL NUMBER OF WORDS USED IN RESERVED 02760000 C BLANK COMMON ( 'RA' FOR SPARC 'SHELLS'). 02770000 C 02780000 C ALLOCATE RA AREA THAT IS USED IN SDFF3D 02790000 C 02800000 IC = 1 02810000 C 02820000 C OBTAIN BLANK COMMON FOR LIST OF OUTPUT VOLUMES. 02830000 C FIRST WORD MUST BE ON A DOUBLE-WORD BOUNDARY (INDEX ODD). 02840000 C IF INDEX OF UNRESERVED COMMON IS ODD, GET 512 WORDS. 02850000 C IF INDEX IS EVEN, GET 513 WORDS AND SKIP ONE WORD. 02860000 C FIRST WORD WILL BE A COUNT OF THE NUMBER OF VOLUMES. 02870000 C SECOND WORD WILL NOT BE USED. 02880000 C THEREAFTER, 255 DOUBLE-WORDS WILL BE USED FOR THE VOLUME NUMBERS. 02890000 C 02900000 IC = IC + 513 02910000 C 02920000 C INDEX OF SAVE AREA FOR THE TRACE HEADER 02930000 C AND THE TRACE 02940000 C 02950000 IC = IC + THL + NOSAMP + 4 02960000 C 02970000 C INDEX OF INTERPOLATED VELOCITY ARRAY 02980000 C 02990000 IC = IC + NOSAMP + 1 03000000 C 03010000 C INDEX OF VELOCITY ARRAY # 1 03020000 C 03030000 IC = IC + NOSAMP + 1 03040000 C 03050000 C INDEX OF VELOCITY ARRAY # 2 03060000 C 03070000 IC = IC + NOSAMP + 1 03080000 C 03090000 C INDEX OF RANGE ARRAY 03100000 C 03110000 IC = IC + 96 03120000 C 03130000 C INDEX OF 'VELF' ID'S ARRAY 03140000 C 03150000 IC = IC + 48 03160000 C 03170000 C=======================================================================03180000 C 03190000 C SET UP RESERVED COMMON INDICIES FOR THE PROCESS SAFF3D0 03200000 C 03210000 C=======================================================================03220000 C 03230000 C=======================================================================03240000 C 03250000 C ALLOCATE RA AREAS FOR STORAGE: 03260000 C 03270000 C IXG - TABLE OF FILTERS (NXTAB,NF) 03280000 C IXDX - OFFSET SPACING IN TABLE FOR EACH FREQUENCY 03290000 C IXXX - MAXIMUM OFFSET IN TABLE FOR EACH FREQUENCY 03300000 C IXSC - SCALAR MULTIPLIER FOR EACH FREQUENCY 03310000 C IXXC - X-COORDINATES RELATIVE TO SHOT 03320000 C IXYC - Y-COORDINATES RELATIVE TO SHOT 03330000 C IXID - TRACE ID-S 03340000 C IXH - INPUT TRACES AND HEADERS 03350000 C IXD - FREQUENCY DOMAIN DATA 03360000 C 03370000 IXG = IC 03380000 IXDX = IXG + 2 * NF * NXTAB 03390000 IXXX = IXDX + NF 03400000 IXSC = IXXX + NF 03410000 IXXC = IXSC + NF 03420000 IXYC = IXXC + MTRC 03430000 IXID = IXYC + MTRC 03440000 IXH = IXID + MTRC 03450000 IXD = IXH + MTRC * LEN 03460000 ICC = IXD + 2 * NF * MTRC 03470000 C 03480000 C=======================================================================03490000 C 03500000 C WRITE (IPR,*) 'IXG = ', IXG , ' IXDX =', IXDX 03510000 C WRITE (IPR,*) 'IXXX = ', IXXX , ' IXSC =', IXSC 03520000 C WRITE (IPR,*) 'IXXC = ', IXXC , ' IXYC =', IXYC 03530000 C WRITE (IPR,*) 'IXID = ', IXID , ' IXH =', IXH 03540000 C WRITE (IPR,*) 'IXD = ', IXD 03550000 C WRITE (IPR,*) 'ICC = ', ICC 03560000 C 03570000 C SET RESERVED COMMON SIZE WITH A 10 % PAD 03580000 C 03590000 CSIZE = 1.10 * ICC 03600000 C 03610000 C=======================================================================03620000 C 03630000 C SET UNRESERVED COMMON SIZE FOR PROCESS 03640000 C 03650000 C=======================================================================03660000 C 03670000 C WORK AREAS IN SA: 03680000 C 03690000 C SA(ISTN) - ARRAY TO HOLD INPUT TRACE NUMBERS (MTRC) 03700000 C SA(ISDX) - ARRAY TO HOLD DIFFERENTIAL OFFSETS (MTRC) 03710000 C SA(ISAD) - ARRAY TO HOLD FILTERED DATA (2*NF*MMRC) 03720000 C SA(ISA1) - ARRAY 1 FOR SCALAR PRODUCT (2*MTRC) 03730000 C SA(ISA2) - ARRAY 2 FOR SCALAR PRODUCT (2*NF*MAX(NTIN)) 03740000 C 03750000 ISTN = 1 03760000 ISDX = ISTN + MTRC 03770000 ISAD = ISDX + MTRC 03780000 ISA1 = ISAD + 2 * NF * MTRC 03790000 ISA2 = ISA1 + 2 * MTRC 03800000 NWORDS = ISA2 + 2 * NF * MTRC 03810000 C 03820000 C=======================================================================03830000 C ADD A 10 % PAD FOR SCRATCH AREA 03840000 C=======================================================================03850000 C 03860000 UCSIZE = 1.10 * NWORDS 03870000 C 03880000 C SET ERROR CODE TO ZERO 03890000 C 03900000 ERCODE = 0 03910000 C 03920000 C WRITE(IPR,9000) PSIZE,CSIZE,UCSIZE 03930000 C9000 FORMAT(/5X,'JSFF3D VERSION 10/02/89 COMPLETED: PSIZE = ',I5, 03940000 C +' CSIZE = ',I10,' UCSIZE = ',I10) 03950000 GO TO 9500 03960000 C 03970000 9200 ERCODE = 16 03980000 WRITE(IPR,9210) KPNA,KPRNO 03990000 9210 FORMAT (/' *** ERROR IN JSFF3D LINE CARD ERROR ',A4,I1) 04000000 GO TO 9500 04010000 C 04020000 9500 RETURN 04030000 C 04040000 C ERROR MESSAGES 04050000 C 04060000 9900 FORMAT (/' *** FROM JSFF3D ERROR IN CORE CALCULATION') 04070000 C 04080000 9910 FORMAT (/' *** ERROR IN JSFF3D NO CARDS FOUND FOR ',A4,I1) 04090000 C 04100000 C 04110000 END 04120000