      SUBROUTINE HYMAGP
C--CALCULATE P AMP MAGNITUDES FOR ALL STATIONS FOR HYPOINVERSE
      INCLUDE 'common.inc'
      CHARACTER STN*5,SNET*2,SCOMP*3
      DIMENSION IATN(7),IAEXP(7),RCAL(7), RSPA(26),IYEARI(7)
      SAVE RSPA

C--ARRAYS FOR GETTING WEIGHTED MEDIAN MAGNITUDES
      DIMENSION IMAG(MAXPHS),IMWT(MAXPHS)

C--RESPONSE CURVE OF THE USGS STANDARD HIGH GAIN (L4C 1 SEC.) RELATIVE TO WA
C  WOOD ANDERSON HAS MAGNIFICATION 2080 & DAMPING 0.8
C     FREQUENCY  .16   .20   .25   .32   .40   .50   .63   .79   1.00
C     LOG FREQ   -.8   -.7   -.6   -.5   -.4   -.3   -.2   -.1   0.0
      DATA RSPA /.288, .432, .561, .680, .786, .891, .983, 1.066,1.138,

C FREQUENCY 1.26   1.59   2.00   2.51   3.16   3.98   5.01   6.31   7.94
C LOG FREQ   .1     .2     .3     .4     .5     .6     .7     .8     .9 
     2   1.205, 1.276, 1.355, 1.443, 1.535, 1.630, 1.726, 1.822, 1.916,

C  FREQUENCY 10.0   12.6   15.9   20.0   25.1   31.6   39.8   50.1
C  LOG FREQ  1.0    1.1    1.2    1.3    1.4    1.5    1.6    1.7
     3    2.007, 2.090, 2.145, 2.099, 1.878, 1.546, 1.172, .771/

C--INITIALIZE SUMS & VALUES
      PAMAD=0.
      PAMAG=0.
      MINPM=0
      PMUSED=0.
      PMCLIP=0.
      PAMAD2=0.
      PAMAG2=0.
      MINPM2=0
      PMUSD2=0.
      PMCLP2=0.

C--RETURN IF NO CALCULATIONS ARE DESIRED
      IF (.NOT.LPMAG) RETURN
      NDATE=KYEAR2*1000000 +KMONTH*10000 +KDAY*100 +KHOUR

C--LOOP OVER STATIONS ++++++++++++++++++++++++++++++++++++++++++++++++++++++
      DO 50 K=1,KSTA
      KPMAG(K)=0
      PNORM(K)=0.
      PAWT(K)=0.
C--SKIP THIS STATION IF NO DATA
      IF (KPAMP(K).EQ.0) GOTO 50
      J=KINDX(K)

C--IF USING A FILE OF CAL FACTORS WITH EXPIRATION DATES, CHECK TO SEE IF
C  CAL FOR THIS STATION HAS EXPIRED.  IF NOT USING A HISTORY FILE,
C  THE EXPIRATION DATE SHOULD ALWAYS BE 0.
      IF (JCEXP(J).GT.0) THEN
        IF (NDATE.GT.JCEXP(J)) THEN

C--FOR INSTRUMENT TYPE 1, USE ATTENUATION HISTORY FILE
          IF (JTYPE(J).EQ.1) THEN

C--READ FILE TO GET A NEW EXPIRATION DATE & ATTENUATION. OPEN ATTENUATION FILE
C  & SEARCH FOR THIS STATION. END OF FILE SHOULD NEVER OCCUR.
            CALL OPENR (13,ATNFIL,'F',IOS)
5           READ (13,1000) STN,SNET,SCOMP,
     2      (IATN(I),IYEARI(I),IAEXP(I),I=1,7)
1000        FORMAT (A5,1X,A2,2X,A3,1X, 7(I2,1X,I4,I6,1X))

            IF (STN(1:NSTLET) .NE. STANAM(J)(1:NSTLET) .OR.
     2      SNET(1:NETLET) .NE. JNET(J)(1:NETLET) .OR.
     3      SCOMP(1:NCOMP) .NE. JCOMP3(J)(1:NCOMP)) GOTO 5

C--SEARCH THE LIST OF EXPIRATION DATES FOR THE FIRST ONE AFTER THE CURRENT DATE,
C  OR AN EXPIRATION DATE OF 0 (CAL GOOD THROUGH THE FUTURE).
            DO I=1,7
C--TRUNCATE YEAR TO 2146, THE LARGEST STORABLE IN I*4, STORE WHOLE DATE
              IF (IYEARI(I).GT.2146) IYEARI(I)=2146
              IAEXP(I)=IYEARI(I)*1000000 +IAEXP(I)

              IF (IAEXP(I).EQ.0 .OR. IAEXP(I).GT.NDATE) THEN
C--ATTEN MUST BE A MULTIPLE OF 6
                KTEMP=IATN(I)/6
                JCAL(J)=CALSV(KTEMP)*1000.

C--WRITE MESSAGE THAT A NEW ATTENUATION WAS FOUND
                IF (LPRT.AND.KPRINT.GE.3) WRITE(15,1001) CALSV(KTEMP),
     2          IATN(I), STN,SNET,SCOMP, JCEXP(J), IAEXP(I)
1001            FORMAT (' * NEW CAL FACTOR',F6.3,' (ATTEN=',I2,
     2          ') ASSIGNED TO ',A5,'-',A2,'-',A3,'.'/
     4          ' NEW CAL FACTOR START DATE = ',
     3          I10,', EXPIRATION DATE = ',I10)
                JCEXP(J)=IAEXP(I)
                GOTO 6
              END IF
            END DO
6           CLOSE (13)
          END IF

C--FOR INSTRUMENT TYPE 3, USE CAL FACTOR HISTORY FILE
          IF (JTYPE(J).EQ.3) THEN

C--READ FILE TO GET A NEW EXPIRATION DATE & CAL FACTOR. OPEN ATTENUATION FILE
C  & SEARCH FOR THIS STATION. END OF FILE SHOULD NEVER OCCUR.
            CALL OPENR (13,CALFIL,'F',IOS)
7           READ (13,1007) STN,SNET,SCOMP,
     2      (RCAL(I),IYEARI(I),IAEXP(I),I=1,7)
1007        FORMAT (A5,1X,A2,2X,A3,1X, 7(F7.2,1X,I4,I6,1X))

            IF (STN(1:NSTLET) .NE. STANAM(J)(1:NSTLET) .OR.
     2      SNET(1:NETLET) .NE. JNET(J)(1:NETLET) .OR.
     3      SCOMP(1:NCOMP) .NE. JCOMP3(J)(1:NCOMP)) GOTO 7

C--SEARCH THE LIST OF EXPIRATION DATES FOR THE FIRST ONE AFTER THE CURRENT DATE,
C  OR AN EXPIRATION DATE OF 0 (CAL GOOD THROUGH THE FUTURE).
            DO I=1,7
C--TRUNCATE YEAR TO 2146, THE LARGEST STORABLE IN I*4, STORE WHOLE DATE
              IF (IYEARI(I).GT.2146) IYEARI(I)=2146
              IAEXP(I)=IYEARI(I)*1000000 +IAEXP(I)

              IF (IAEXP(I).EQ.0 .OR. IAEXP(I).GT.NDATE) THEN
                JCAL(J)=RCAL(I)*1000.

C--WRITE MESSAGE THAT A NEW CAL FACTOR WAS FOUND
                IF (LPRT .AND. KPRINT.GE.3) WRITE (15,1008) RCAL(I),
     2          STN,SNET,SCOMP, JCEXP(J), IAEXP(I)
1008            FORMAT (' * NEW CAL FACTOR',F6.3,
     2          ' ASSIGNED TO ',A5,'-',A2,'-',A3,'.'/
     4          ' NEW CAL FACTOR START DATE = ',
     3          I10,', EXPIRATION DATE = ',I10)
                JCEXP(J)=IAEXP(I)
                GOTO 8
              END IF
            END DO
8           CLOSE (13)
          END IF

        END IF
      END IF

C--CALCULATE P AMPLITUDE MAGNITUDE --------------------------------------

C--COMPUTE PAMAG AS A SUM OF 3 TERMS:
C--1: LOG(P PEAK-TO-PEAK AMP / 2*CAL FACTOR)
C--2: -LOG RESPONSE OF INST REL TO WOOD-ANDERSON AT 5 HZ.
C--3: -LOG(A(0)), THE LOCAL MAGNITUDE DISTANCE CORRECTION
C--FQ = LOG(FREQUENCY OF P WAVE / 5HZ.)
C--SLDIS = HYPOCENTRAL DISTANCE IN KM
CC--ALDSQ = LOG((HYPOCENTRAL DISTANCE)**2)

C--USE KCAL IN PREFERENCE TO JCAL IF KCAL IS PRESENT
      IF (KCAL(K).EQ.0) THEN
        CAL=.001*JCAL(J)
      ELSE
        CAL=.01*KCAL(K)
      END IF
      IF (CAL.EQ.0.) GO TO 50

C--THE PERIOD FOR P IS PRESENTLY UNSPECIFIED, THEREFORE USE .2 SEC
C  AND COMMENT OUT THE USE OF PERIOD AT THE MAXIMUM AMPLITUDE
      PER=.2

C--NOTE: PERIOD IS PRESENTLY UNSPECIFIED FOR P AMPLITUDES, SO SKIP THIS STUFF:
C--SET THE PERIOD AS STANDARD ONE FOR STATION IF NOT ON PHASE CARD
C  JPER(J) IS THE STATION PERIOD IN .1 SEC.
C  KPER(K) IS THE PHASE CARD PERIOD IN .01 SEC.
C      IF (KPER(K).LE.0) THEN
C        PER= .1*JPER(J)
C      ELSE
C        PER=.01*KPER(K)
C      END IF
C--SKIP THE CALCULATIONS IF PERIOD IS OUT OF ALLOWED RANGE
C      IF (PER.GT.6.3 .OR. PER.LT..02) GOTO 50

C--COMPUTE MAGNITUDE
      SLDIS=SQRT(Z1**2 +DIS(K)**2) +.01

C--KPAMP IS THE P AMPLITUDE AVERAGED FOR THE FIRST 3 PEAKS IN MILLIVOLTS
C--CONVERT AMPLITUDE TO PEAK-TO-PEAK MILLIMETERS ON DEVELOCORDER VIEWER
C  FOR COMPATIBILITY WITH OLDER XMAG FORMULATION.
C--FOR THE RTP,          CNT2MM=0.040:  2.5V = 2500 COUNTS = 100MM SOURCE=P,R,O
C--FOR EARTHWORM & CUSP, CNT2MM=.0488:  2.5V = 2048 COUNTS = 100MM SOURCE=W
C--FOR OTHERS, USE DEFAULT VALUE

      AMP=KPAMP(K)*CNT2MD
      DO I=1,NCNTMM
        IF (KSOU(K) .EQ. CCNTMM(I)) AMP=KPAMP(K)*CNT2MM(I)
      END DO

C--AMP IS PEAK-TO-PEAK AMPLITUDE IN MM (.5 IS TO USE HALF-AMP)
      SMAG= ALOG10(AMP*.5/CAL)

C--CONVERT OBSERVED P AMP TO S AMP. ACCORDING TO AKI & RICHARDS, 
C  As/Ap = (Vp/Vs)**3 = 1.73**3 = 5.178 = 10**0.7141
      SMAG=SMAG +.7141

C--CORRECT TO WA RESPONSE TO A STANDARD NETWORK STATION
C--ALSO CORRECT DIGITAL TELEMETRY STATIONS (TYPE 3) WITH SAME CURVE
C  (OLD APPROXIMATION FOR DOMINANT FREQ)
      IF (JTYPE(J).EQ.1 .OR. JTYPE(J).EQ.3) THEN
        FQ=10.*ALOG10(1./PER)+9.
        IFQ=FQ
C--USE RESPONSE CORRECTION INTERPOLATED FROM TABLE
        SMAG=SMAG -(RSPA(IFQ) +(FQ-IFQ) *(RSPA(IFQ+1)-RSPA(IFQ)))
      END IF

C--DONT APPLY XMAG CORRECTIONS SPECIFIED FOR EACH COMPONENT. 
C      DO I=1,NXCM
C        IF (JCOMP3(J)(1:NCOMP) .EQ. CXCM(I)(1:NCOMP)) SMAG=SMAG+AXCM(I)
C      END DO

C--CORRECT AN HVO TYPE SPRENGNETHER
      IF (JTYPE(J).EQ.2) SMAG=SMAG+.41+.56*ALOG10(.2/PER)

C--APPLY RICHTER'S LOGA0 DISTANCE CORRECTION TERM 
C--USE THE RELATION SPECIFIED FOR P AMP MAGS
      CALL LOGA0 (LATYPP,A0MAG,DIS(K),SLDIS)
      SMAG=SMAG+A0MAG

C--OUTPUT LOG(A0) TERM IN REMARK COLUMN OF PRINTOUT (DEBUG ONLY)
C      WRITE (KRMK6(K),'(F4.2,''-'',I1)') A0MAG,LATYP
C      WRITE (KRMK6(K),'(F4.2,''-'',I1)') xx,LATYPP
      
C--APPLY STATION'S INDIVIDUAL MAG CORRECTION
      SMAG=SMAG+.01*JXCOR(J)

C--CHOOSE CONSTANTS OF LINEAR TRANSFORM FOR PMAG 1 OR 2, DEPENDING ON COMPONENT.
C--IF COMPONENT QUALIFIES FOR BOTH, USE SECOND.
C--TRASFORMING MAG CAN ACCOMODATE FOR FAILURE TO APPLY PERIOD CORRECTION,
C  AND FOR UNMODELED SOURCE EFFECTS.
C--DO NOT MAKE BOTH CORRECTIONS IF COMPONENT IS USED FOR BOTH MAGS.

      IF (JPM2(J)) THEN
        SMAG= PMA2 +PMB2*SMAG
      ELSE IF (JPM1(J)) THEN
        SMAG= PMA1 +PMB1*SMAG
      END IF

C--STORE MAGNITUDE
      KPMAG(K)=NINT(100.*SMAG)

C--CODE SIMILAR TO THIS WILL BE USED IF WE EVER USE STATION WEIGHTS FOR PMAG
C$      KXMWT=0
C$      IF (KXWT(K).LT.4) KXMWT=NINT (2.5*((4-KXWT(K))*JXWT(J)))

C--DETERMINE THE WEIGHT FOR THIS P MAGNITUDE.
C--CLIPPING OF THE P WAVE COULD BE FREQUENT.  ITS WEIGHT CODE IS THE NUMBER
C  OF CLIPPED PEAKS IN THE FIRST 3 SWINGS. 
C  THIS CODE IS NOT USED TO DETERMINE THE ACTUAL WEIGHT, ONLY FOR CLIPPING.

C--THE WEIGHT IS THE PRODUCT OF 3 TERMS, AND NEED NOT BE NORMALIZED:
C  1) WEIGHTING FOR DIFFERENT COMPONENTS (IE LOWER GAIN CARRIES MORE WEIGHT)
C  2) P WAVE ARRIVAL TIME WEIGHT (UNCERTAIN & EMERGENT PHASES HAVE LOW WEIGHT)
C    NOTE: ALLOW FOR UPWEIGHTING OF VALID P'S WITH 5 ADDED TO WEIGHT CODE
C  3) THE SPECIFIC WEIGHT ASSIGNED TO AMP MAGS (ALSO XMAG) FROM THIS STATION

C--DECODE P & S WEIGHTS
      LSWT=KWT(K)/10
      L=KWT(K)-10*LSWT

C--DETERMINE P ARRIVAL TIME WEIGHT
      IF (L.EQ.0 .OR. L.EQ.5) THEN
        PAWT(K)=1.
      ELSE IF (L.EQ.1 .OR. L.EQ.6) THEN
        PAWT(K)=0.5
      ELSE IF (L.EQ.2 .OR. L.EQ.7) THEN
        PAWT(K)=0.25
      ELSE IF (L.EQ.3 .OR. L.EQ.8) THEN
        PAWT(K)=0.125
      ELSE
        PAWT(K)=0.
      END IF

C--APPLY STATION WEIGHT FACTOR: JXWT=0 FOR NO WEIGHT, JXWT=10 FOR FULL WEIGHT
      PAWT(K) =PAWT(K) *JXWT(J) *0.1

C--APPLY COMPONENT WEIGHT (PAC COMMAND) FOR THOSE THAT ARE NOT 1.0
      DO I=1,NPWM
        IF (JCOMP3(J)(1:NCOMP) .EQ. CPWM(I)(1:NCOMP))
     2  PAWT(K)=PAWT(K)*WPWM(I)
      END DO

50    CONTINUE

C----------- CALCULATE P AMPLITUDE MAGNITUDE FOR EVENT -------------------

C--DETERMINE THE NORM FOR EACH STATIONS PAMAG. THE MAGNITUDE OF THE STATION
C  WITH THE SMALLEST NORM IS THE L1 ESTIMATE OF THE EVENT P MAG.
C--THE NORM DEPENDS ON THE COMPARISON OF THE TEST MAGNITUDE OF THE STATION
C  FOR WHICH THE NORM IS COMPUTED (INDEX K) WITH ALL OTHER PAMAG'S (INDEX L).
C--NORM(K)= SUM-OVER-L (WEIGHT(L)*ABS[MAG(L) -MAG(K)]) /  SUM-OVER-L WEIGHT(L)
C--INITIALIZE THE REGISTER FOR FINDING MINIMUM NORM:
      PNORMN=9.
      PNRMN2=9.
      KMNNOR=0
      KMNNR2=0

C--LOOP OVER STATIONS TO COMPUTE THEIR NORMS
      DO 70 K=1,KSTA
        IF (KPAMP(K).EQ.0) GOTO 70
        J=KINDX(K)

C--INITIALIZE REGISTERS FOR CALCULATING NORM:
        TOTDEL=0.
        TOTWT=0.
        TOTDL2=0.
        TOTWT2=0.

C--LOOP OVER ALL STATIONS
        DO 60 L=1,KSTA
          IF (KPAMP(L).EQ.0) GOTO 60
          JL=KINDX(L)
          DELTM= .01*(KPMAG(L) -KPMAG(K))

C--CLIPPED STATIONS SHOULD ONLY CONTRIBUTE TO THE NORM IF THEIR MAGS ARE
C  LARGER THAN THE TEST MAG.  THE MAG FROM A CLIPPED STATION IS A MINIMUM EST.
C  THAT SHOULD DRIVE THE AVERAGE MAG UPWARD BUT NOT DOWNWARD.
          IF (DELTM.LT.0. .AND. KPAWT(L).GT.1) GOTO 60

C--ADD TERMS FOR THE NORM
C--PRIMARY PAMAG
          IF (JPM1(J) .AND. JPM1(JL)) THEN
            TOTDEL= TOTDEL +PAWT(L) *ABS(DELTM)
            TOTWT= TOTWT +PAWT(L)
          END IF

C--SECONDARY PAMAG
          IF (JPM2(J) .AND. JPM2(JL)) THEN
            TOTDL2= TOTDL2 +PAWT(L) *ABS(DELTM)
            TOTWT2= TOTWT2 +PAWT(L)
          END IF
60      CONTINUE

C--CALCULATE NORM AND STORE IF IT IS A MINIMUM.
C--NOTE THAT WE ARE COMPUTING NORMS FOR ALL STATIONS WITH A PMAG INCLUDING
C  THE STATIONS WITH NO WEIGHT THEMSELVES.  THE EVENT PMAG MAY THUS NOT BE
C  ONE OF THE SET OF WEIGHTED STATIONS.
C  DONT COMPUTE NORM IF NO DATA AT ALL WERE WEIGHTED
        IF (TOTWT.GT.0.) THEN
          PNORM(K)= TOTDEL/TOTWT
        ELSE
          PNORM(K)=9.
        END IF
        IF (TOTWT2.GT.0.) THEN
          PNORM2(K)= TOTDL2/TOTWT2
        ELSE
          PNORM2(K)=9.
        END IF

C--SAVE THE MINIMUM NORMS AND WHERE IT IS
        IF (PNORM(K) .LT. PNORMN) THEN
          PNORMN= PNORM(K)
          KMNNOR= K
        END IF
        IF (PNORM2(K) .LT. PNRMN2) THEN
          PNRMN2= PNORM2(K)
          KMNNR2= K
        END IF
70    CONTINUE

C--ALSO SAVE THE 2ND AND 3RD MINIMUM NORMS FOR PRIMARY PAMAG
      PNORMB=9.
      KMNB=0
      DO K=1,KSTA
        IF (KPAMP(K).GT.0) THEN
          IF (PNORM(K) .LT. PNORMB .AND. K.NE.KMNNOR) THEN
            PNORMB= PNORM(K)
            KMNB= K
          END IF
        END IF
      END DO

      PNORMC=9.
      KMNC=0
      DO K=1,KSTA
        IF (KPAMP(K).GT.0) THEN
          IF (PNORM(K) .LT. PNORMC .AND. K.NE.KMNNOR .AND.
     2    K.NE.KMNB) THEN
            PNORM3= PNORM(K)
            KMN3= K
          END IF
        END IF
      END DO

C--ALSO SAVE THE 2ND AND 3RD MINIMUM NORMS FOR SECONDARY PAMAG
      PNRMB2=9.
      KMNB2=0
      DO K=1,KSTA
        IF (KPAMP(K).GT.0) THEN
          IF (PNORM2(K) .LT. PNRMB2 .AND. K.NE.KMNNR2) THEN
            PNRMB2= PNORM2(K)
            KMNB2= K
          END IF
        END IF
      END DO

      PNRMC2=9.
      KMNC2=0
      DO K=1,KSTA
        IF (KPAMP(K).GT.0) THEN
          IF (PNORM2(K) .LT. PNRMC2 .AND. K.NE.KMNNR2 .AND.
     2    K.NE.KMNB2) THEN
            PNRMC2= PNORM2(K)
            KMNC2= K
          END IF
        END IF
      END DO

C--THE P AMP MAG FOR THE EVENT IS THAT OF THE STA WITH SMALLEST NORM
      IF (KMNNOR.GT.0) PAMAG= .01*KPMAG(KMNNOR)
      IF (KMNNR2.GT.0) PAMAG2= .01*KPMAG(KMNNR2)

C--ZERO PARAMETERS & COUNT WEIGHTS FOR NUMBER OF STATIONS
      PMUSED=0.
      PMCLIP=0.
      PMUSD2=0.
      PMCLP2=0.
      DO K=1,KSTA
        IF (KPAMP(K).GT.0) THEN
          J=KINDX(K)
          IF (JPM1(J)) THEN
            PMUSED= PMUSED +PAWT(K)
            IF (KPAWT(K).GT.1) PMCLIP= PMCLIP +PAWT(K)
          END IF
          IF (JPM2(J)) THEN
            PMUSD2= PMUSD2 +PAWT(K)
            IF (KPAWT(K).GT.1) PMCLP2= PMCLP2 +PAWT(K)
          END IF
        END IF
      END DO

C--FLAG THIS PAMAG AS A MINIMUM MAG IF:
C  1) 1 OF THE 3 MINIMUM NORM STATIONS ARE CLIPPED
C  2) MORE THAN CLPRAT (ABOUT 0.40) OF THE STATIONS ARE CLIPPED
C--PRIMARY P AMP MAGNITUDE
      MINPM=0
      L=0
      IF (KPAWT(KMNNOR).GT.1) L=L+1
      IF (KMNB.GT.0 .AND. KMNC.GT.0) THEN
        IF (KPAWT(KMNB).GT.1) L=L+1
        IF (KPAWT(KMNC).GT.1) L=L+1
      END IF
      IF (L.GT.0) MINPM=1
      IF (PMUSED.GT.0.) THEN
        IF (PMCLIP/PMUSED .GE. CLPRAT) MINPM=1
      END IF

C--SECONDARY P AMP MAGNITUDE
      MINPM2=0
      L=0
      IF (KPAWT(KMNNR2).GT.1) L=L+1
      IF (KMNB2.GT.0 .AND. KMNC2.GT.0) THEN
        IF (KPAWT(KMNB2).GT.1) L=L+1
        IF (KPAWT(KMNC2).GT.1) L=L+1
      END IF
      IF (L.GT.0) MINPM2=1
      IF (PMUSD2.GT.0.) THEN
        IF (PMCLP2/PMUSD2 .GE. CLPRAT) MINPM2=1
      END IF

C--CALC MEDIAN ABSOLUTE DIFFERENCE OF P AMP MAG & COUNT WEIGHTS
C--PASS THROUGH THE STATION LIST AND ACCUMULATE DIFFS IN A SEPARATE ARRAY
C--PRIMARY P AMP MAGNITUDE
      NMED=0
      DO K=1,KSTA
        J=KINDX(K)
        IF (KPAMP(K).GT.0 .AND. K.NE.KMNNOR .AND. JPM1(J)) THEN
          NMED=NMED+1
          IMAG(NMED)= ABS(KPMAG(K) -NINT(100.*PAMAG))
          IMWT(NMED)= 100.*PAWT(K)
        END IF
      END DO
      CALL MEDWT (NMED,IMAG,IMWT,MEDIAN)
      PAMAD=.01*MEDIAN

C--SECONDARY P AMP MAGNITUDE
      NMED=0
      DO K=1,KSTA
        J=KINDX(K)
        IF (KPAMP(K).GT.0 .AND. K.NE.KMNNR2 .AND. JPM2(J)) THEN
          NMED=NMED+1
          IMAG(NMED)= ABS(KPMAG(K) -NINT(100.*PAMAG))
          IMWT(NMED)= 100.*PAWT(K)
        END IF
      END DO
      CALL MEDWT (NMED,IMAG,IMWT,MEDIAN)
      PAMAD2=.01*MEDIAN

      RETURN
      END
