CTITLEJSSURG - JOBGEN REGION & BLANK COMMMON ALGORITHM FOR SURG C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR C. L. JOYNER CA DESIGNER C. L. JOYNER CA LANGUAGE VS FORTRAN CA SYSTEM IBM / CRAY CA WRITTEN 06-03-91 CA CA REVISED XX-XX-XX XXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CA CA CALL JSSURG (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 PROCESS 'SURG'. CA C C EJECT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE JSSURG (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, + ERCODE) C IMPLICIT INTEGER (A-Z) C C CHARACTER*4 KPNA CHARACTER*80 CARD C C INTEGER CONSTANTS -- LOCAL C INTEGER IPR INTEGER THL C C C REAL VARIABLES -- LOCAL C C REAL C C DATA IPR / 98 / DATA THL / 190 / C C C ======================================================= C BEGIN COMPUTATION OF REGION AND COMMON SIZE FOR SURG C (INSERT REGION SIZE & BLANK COMMON SIZE CALCULATIONS HERE) C ======================================================== C C C======================================================================= C C PART 1. SET PROGRAM SIZE IN K-BYTES (PSIZE) C C PSIZE = 30 C C GET LINE CARD PARAMETERS C DA = 1 CALL FORC ('LINE', 0, DA, CARD, * 9200 ) C LCTPSP = S1CVBN (CARD, 36, 5) LCMXFD = S1CVBN (CARD, 61, 5) IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP C LCRLEN = S1CVBN (CARD, 41, 5) LCSI = S1CVBN (CARD, 46, 5) LCPI = S1CVBN (CARD, 51, 5) IF (LCPI .EQ. 0) LCPI = LCSI C C IF (LCPI .EQ. 0) GO TO 9800 C ABOVE LINE IS COMMENTED BUT INTENTIONALY LEFT FOR CLARITY. C THE LCPI NON ZERO CHECK SHOULD BE DONE IN JSCORE OR JSRND C AND THEREFORE IS REDUNDANT HERE. C C NOSAMP = LCRLEN / LCPI C C C C======================================================================= 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 ICC = 0 C SR = LCPI NBL = NOSAMP C C C READ INPUT CARDS C DAC = 1 110 CALL FORC (KPNA, KPRNO, DAC, CARD, * 9300) IF (CARD(8:10) .NE. ' ') GO TO 110 C READ(CARD,120) CDPSTR,CDPEND,LINEST,LINEND 120 FORMAT(10X,2I5,45X,2I5) C IF( CDPEND .EQ. 0) CDPEND = CDPSTR C NCDP = CDPEND - CDPSTR + 1 NLINE = LINEND - LINEST + 1 C C C READ PRM CARD DAC = 1 310 CALL FORC (KPNA, KPRNO, DAC, CARD , * 340) IF (CARD(8:10) .NE. 'PRM') GO TO 310 C READ(CARD,320) NCEP,OPERLN,PREDIS 320 FORMAT(20X,3I5) C 340 CONTINUE IF (NCEP .EQ. 0) NCEP = 64 IF (OPERLN .EQ. 0) OPERLN = 400 IF (PREDIS .EQ. 0) PREDIS = LCPI CCLJ1 C WRITE (IPR,18801)NOSAMP,NCDP,NLINE,NCEP,OPERLN,PREDIS C8801 FORMAT(/1X,'NOSAMP,NCDP,NLINE,NCEP,OPERLN,PREDIS',/1X,6I8) CCLJ2 C C C COMPUTE RESERVED MEMORY C C DLOCAL MEMORY LLOCAL = 104 C SURF EXTERNAL TRACE INPUT AREA NOWDS = NOSAMP + THL + 1 C RANGE NUMBERS LR1 = NLINE * NCDP C AREA NEEDED FOR OPERATOR APPLICATION NOPER = IABS (OPERLN/LCPI) LCEPOP = NCEP IF (NOPER .GT. NCEPOP) LCEPOP = NOPER LCEPOP = .999999 + ALOG(FLOAT(LCEPOP)) / ALOG(2.) MAG = LCEPOP + 2 LCEPOP = 2**MAG IF (LCEPOP .LT. 128) LCEPOP = 128 C SUMMING WORK AREA C ! DUPLICATE COPY OF CEPSTRUM C ! ! AUTOCORRELATION SCRATCH AREA C ! ! ! OPERATOR SCRATCH AREA C ! ! ! ! WAVELET SCRATCH C ! ! ! ! ! LR2 = LCEPOP + NCEP + LCEPOP/2 + LCEPOP/2 + LCEPOP/2 C C 2-D SURF AUX TRACE AREA LR3 = NOSAMP + 1 C INPUT TRACE SAVE AREA LR4 = NOSAMP + 1 CCLJ1 C WRITE (IPR,18802)NOWDS,LR1,NOPER,LCEPOP,LR2,LR3,LR4 C8802 FORMAT(/1X,'NOWDS,LR1,NOPER,LCEPOP,LR2,LR3,LR4',/1X,7I8) CCLJ2 C C C ICC = LLOCAL + NOWDS + LR1 + LR2 + LR3 + LR4 C C C SET RESERVED COMMON SIZE IN WORDS C CSIZE = ICC C C C C======================================================================= C C PART 3. COMPUTE UNRESERVED BLANK COMMON SIZE IN WORDS (UCSIZE) C UCSIZE = 0 C C UPSURG SCRATCH AREA JPD = PREDIS/LCPI NC = ALOG (FLOAT(NOSAMP+NOPER+JPD)) / ALOG(2.) + 0.0001 NWDS = 2**(NC+1) LU1 = 5*NWDS + 2*LCEPOP + 5 IF ( LU1 .LT. 16385) LU1 = 16385 CCLJ1 C WRITE (IPR,18803)JPD, NC, NWDS C8803 FORMAT(/1X,'JPD, NC, NWDS',/1X,3I8) CCLJ2 C C NWORDS = LU1 C C C SET UNRESERVED COMMON SIZE IN WORDS C UCSIZE = NWORDS C C C ERCODE = 0 C GO TO 9999 C C********************************************************************** C ERROR MESSAGES C********************************************************************** C 9200 ERCODE = 16 WRITE(IPR,19200) KPNA,KPRNO 19200 FORMAT (/' *** ERROR IN JSSURG LINE CARD ERROR ',A4,I1) GO TO 9999 C 9300 ERCODE = 16 WRITE(IPR,19300) KPNA,KPRNO 19300 FORMAT (/' *** ERROR IN JSSURG; NO CARDS FOUND FOR ',A4,I1) GO TO 9999 C C C EXIT C 9999 CONTINUE WRITE(IPR,9000) PSIZE,CSIZE,UCSIZE 9000 FORMAT(/5X,'JSSURG VERSION COMPLETED: PSIZE = ',I5, + ' CSIZE = ',I10,' UCSIZE = ',I10) C RETURN END