CTITLEJSLMPA - JOBGEN REGION & BLANK COMMMON ALGORITHM FOR LMPA C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR W. R. FIELDER CA DESIGNER W. R. FIELDER CA LANGUAGE VS FORTRAN CA WRITTEN 12-13-91 CA CA CALL JSLMPA (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, CA ERCODE) CA CA INPUT KPNA = PROCESS NAME A4 CA INPUT KPRNO = PROCESS NUMBER I4 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 CA KPRNO CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 CA OUTPUT CSIZE = RESERVED BLANK COMMON SIZE IN WORDS I4 CA OUTPUT UCSIZE = UNRESERVED BLANK COMMON SIZE IN WORDS I4 CA OUTPUT ERCODE = ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 CA THE REQUIRED PARAMETERS) CA CA CA COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON CA (CSIZE) NEEDED BY SPARC DEVELOPMENT PROCESS 'NAME'. CA JSLMPA IS AN EXTENSION OF SUBROUTINE JSRND. C C CA EJECT CAEND C SUBROUTINE JSLMPA (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, + ERCODE) C IMPLICIT INTEGER (A-Z) C C MAXCTP - MAXIMUM NUMBER OF CDP-TOP OF TIME WINDOW C PAIRS THAT CAN BE HANDLED. C PARAMETER (MAXCTP = 1000) C C CHARACTER*4 KPNA CHARACTER*80 CARD C C INTEGER CONSTANTS -- LOCAL C INTEGER IPR INTEGER THL C DATA IPR / 98 / DATA THL / 190 / C C C ==================================================== C BEGIN COMPUTATION OF REGION AND COMMON SIZE FOR LMPA C (INSERT REGION SIZE & BLANK COMMON SIZE CALCULATIONS HERE) C =========================================== C C C PART 1. SET PROGRAM SIZE IN K-BYTES (PSIZE) C C PSIZE = 100 C 00700000 C GET LINE CARD PARAMETERS 00710000 C 00720000 DA = 1 00730000 CALL FORC ('LINE', 0, DA, CARD, * 9200 )00740000 C 00750000 LCTPSP = S1CVBN (CARD, 36, 5) 00760000 LCMXFD = S1CVBN (CARD, 61, 5) 00760000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 00790000 C 00750000 LCRLEN = S1CVBN (CARD, 41, 5) 00760000 LCSI = S1CVBN (CARD, 46, 5) 00770000 LCPI = S1CVBN (CARD, 51, 5) 00780000 IF (LCPI .EQ. 0) LCPI = LCSI 00790000 C 00800010 C IF (LCPI .EQ. 0) GO TO 9800 00810000 C ABOVE LINE IS COMMENTED BUT INTENTIONALY LEFT FOR CLARITY. 00820000 C THE LCPI NON ZERO CHECK SHOULD BE DONE IN JSCORE OR JSRND AND 00830010 C THEREFORE IS REDUNDANT HERE. 00840010 C 00850010 1 FORMAT (I5) C C======================================================================= C ONLY ONE PROCESSING RANGE IS PERMITTED C======================================================================= C C *************************************************** C ****** RETRIEVE PROCESSING PARAMETERS ****** C *************************************************** C DAC = 1 C 160 CONTINUE CALL FORC ( KPNA, KPRNO, DAC, CARD, *320 ) C IF (CARD(8:10) .NE. ' ') GO TO 160 C C####################################################################### C C READ THE STARTING DEPTH POINT NUMBER FOR THIS PROCESSING RANGE C READ ( CARD(11:15), 1 ) R1 C C READ THE ENDING DEPTH POINT NUMBER FOR THIS PROCESSING RANGE C READ ( CARD(16:20), 1 ) R2 C C FIND THE TOTAL NUMBER OF CDP C NSIZE = IABS(R2-R1) + 1 C C----------------------------------------------------------------------- C C MAXIMUM NUMBER OF TRACES PER CDP FOR ANALYSIS C C (THE MAXIMUM NUMBER WILL BE THE NUMBER OF CDP TRACES) C C----------------------------------------------------------------------- C READ ( CARD(21:25), 1 ) NX C 320 CONTINUE C NOSAMP = LCRLEN / LCPI C C PART 2. COMPUTE RESERVED BLANK COMMON SIZE IN WORDS (ICC) C C THIS VALUE, FOR MOST CASES, IS IDENTICAL TO THE COMPUTATION OF C RESERVED BLANK COMMON IN THE INITIALIZATION PART OF THE PROCESS C (THE '0 ENTRY' FOR SPARC 'SHELLS'). THIS VALUE IS TYPICALLY C CALLED 'ICC' AND IS THE TOTAL NUMBER OF WORDS USED IN RESERVED C BLANK COMMON ( 'RA' FOR SPARC 'SHELLS'). C C ALLOCATE RA AREA THAT IS USED IN SDLMPA C IC = 1 C C OBTAIN BLANK COMMON FOR LIST OF OUTPUT VOLUMES. C FIRST WORD MUST BE ON A DOUBLE-WORD BOUNDARY (INDEX ODD). C IF INDEX OF UNRESERVED COMMON IS ODD, GET 512 WORDS. C IF INDEX IS EVEN, GET 513 WORDS AND SKIP ONE WORD. C FIRST WORD WILL BE A COUNT OF THE NUMBER OF VOLUMES. C SECOND WORD WILL NOT BE USED. C THEREAFTER, 255 DOUBLE-WORDS WILL BE USED FOR THE VOLUME NUMBERS. C IC = IC + 513 C C INDEX OF SAVE AREA FOR THE TRACE HEADER C AND THE TRACE C IC = IC + THL + NOSAMP + 4 C C INDEX OF INTERPOLATED VELOCITY ARRAY C IC = IC + NOSAMP + 1 C C INDEX OF VELOCITY ARRAY # 1 C IC = IC + NOSAMP + 1 C C INDEX OF VELOCITY ARRAY # 2 C IC = IC + NOSAMP + 1 C C INDEX OF RANGE ARRAY C IC = IC + 96 C C INDEX OF 'VELF' ID'S ARRAY C IC = IC + 48 C C SET UP RESERVED COMMON INDICIES C C START INDEX FOR OUTPUT ANGLE GATHER (NOSAMP,NANG) C INDATA = IC C C START INDEX FOR WINDOW CDP NUMBER (MAXCTP) C INICDP = INDATA + NOSAMP * NX C C START INDEX FOR WINDOW TIME VALUE (MAXCTP) C INITIME = INICDP + MAXCTP C C START INDEX INPUT DATA (NOSAMP,NX) C ININPUT = INITIME + MAXCTP C C START INDEX INCIDENCE ANGLE RANGE (2*NX) C ININCI = ININPUT + NOSAMP * NX C C START INDEX INTERVAL VELOCITY (NOSAMP) C ININTV = ININCI + 2 * NX C C START INDEX DEPTH INTERVAL (NOSAMP) C INDEPTH = ININTV + NOSAMP C C START INDEX OFFSET DISTANCE (NX) C INOFF = INDEPTH + NOSAMP C C START INDEX ANGLE WINDOWS (2*NX) C INANGW = INOFF + NX C C START INDEX ARRAY OF FIRST LIVE VALUE IN TRACES (NX) C INFLV = INANGW + 2 * NX C C START INDEX TRACE HEADERS C INHEAD = INFLV + NX C C WORK X ARRAY (NOSAMP) C INWORK = INHEAD + THL * NX C C WORK ARRAY STORE INTERPOLATED CDP NO. FOR TIME PAIRS (NSIZE) C INCDPI = INWORK + NOSAMP C C WORK ARRAY STORE INTERPOLATED TIME PICKS (NSIZE) C INTBEGI = INCDPI + NSIZE C C TOTAL RESERVED SPACE C ICC = INTBEGI + NSIZE C C IF DEBUG PRINT SET THEN DUMP RESERVED COMMON INDICIES C C WRITE (IPR,*) 'INDATA = ', INDATA, ' INICDP =', INICDP C WRITE (IPR,*) 'INITIME = ', INITIME, ' ININPUT =', ININPUT C WRITE (IPR,*) 'ININCI = ', ININCI, ' ININTV =', ININTV C WRITE (IPR,*) 'INDEPTH = ', INDEPTH, ' INOFF =', INOFF C WRITE (IPR,*) 'INANGW = ', INANGW, ' INFLV =', INFLV C WRITE (IPR,*) 'INHEAD = ', INHEAD, ' INWORK =', INWORK C WRITE (IPR,*) 'INCDPI = ', INCDPI, ' INTBEGI =', INTBEGI C WRITE (IPR,*) 'ICC = ', ICC C C C SET RESERVED COMMON SIZE WITH A 10 % PAD C CSIZE = 1.10 * ICC C C SET UNRESERVED COMMON SIZE TO ZERO C UCSIZE = 0 C C SET ERROR CODE TO ZERO C ERCODE = 0 C C WRITE(IPR,9000) PSIZE,CSIZE,UCSIZE C9000 FORMAT(/5X,'JSLMPA VERSION 10/02/89 COMPLETED: PSIZE = ',I5, C +' CSIZE = ',I10,' UCSIZE = ',I10) GO TO 9500 C 9110 ERCODE = 16 WRITE(IPR,9900) KPNA,KPRNO GO TO 9500 C 9200 ERCODE = 16 WRITE(IPR,9210) KPNA,KPRNO 9210 FORMAT (/' *** ERROR IN JSLMPA LINE CARD ERROR ',A4,I1) GO TO 9500 C 9500 RETURN C C ERROR MESSAGES C 9900 FORMAT (/' *** FROM JSLMPA ERROR IN CORE CALCULATION') C 9910 FORMAT (/' *** ERROR IN JSLMPA NO CARDS FOUND FOR ',A4,I1) C C END