       SUBROUTINE MPACK(A,LDA,MA,MVALUE,N,ERSTAT)
C
C **********************************************************************
C
C    NAME-MPACK
C
C    LANGUAGE-VS FORTRAN      TYPE-SUBROUTINE     COMPUTER-CRAY J916
C
C    VERSION-1.0    DATE-10/03/90   PROGRAMMER- T. SIMMS, SMSRC
C    VERSION-2.0    DATE-07/19/94   PROGRAMMER- FRANK TILLEY (SMSRC)
C         ATOVS-12  EXPLICITLY DECLARED I*4 VARIABLE "LDA".
C    VERSION-3.0    DATE-06/04/96   PROGRAMMER- TIM GARDNER (HSTX)
C
C    FUNCTION-REMOVES THE ROWS AND COLUMNS CORRESPONDING TO
C    UNSAMPLED DATA OBSERVATIONS FROM MATRIX A
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY.
C
C    CALLING PARAMETERS-
C
C    NAME        TYPE   I/O DESCRIPTION
C    ----        ----   --- ----------------------------------
C     A          REAL    I/O MATRIX THAT IS PACKED
C     LDA        INT     I  LEADING DIMENSION OF MATRIX A AS DECLARED
C                             BY THE CALLING ROUTINE
C     MA         INT    I/O SIZE OF MATRIX A
C     MVALUE     INT     I  ORDERED LIST OF ROW & COL NUMBERS
C                           CORRESPONDING TO UNSAMPLED DATA
C                           OBSERVATIONS
C     N          INT     I  NO. OF UNSAMPLED DATA OBSERVATIONS
C     ERSTAT     INT     O  ERROR STATUS CODE RETURNED FROM MPACK$
C
C     LOCAL PARAMETERS-
C
C     NAME        TYPE       DESCRIPTION
C     ----        ----       ----------------------------------
C     I, J, K     INT        DO LOOP INDEXES
C     IBEG        INT        DO LOOP INDEX
C
C     SUBPROGRAMS CALLED - MPACK$
C
C     FUNCTIONS USED - NONE
C
C     EXIT STATES - ROUTINE WILL RETURN WHEN A FATAL ERROR IS RETURNED
C                   FROM MPACK$ OR IF NO MISSING VALUES ARE FOUND
C
C **********************************************************************
C
      INTEGER I,J,K,N,MA,IBEG,MVALUE(N),ERSTAT,LDA
      REAL A(LDA,MA)
C
      DATA IBEG /0/
C
C  IF NO MISSING VALUES THEN EXIT
      IF (N.LE.0) RETURN
C
C  IF ALL VALUES MISSING PRINT MESSAGE TO DEBUG FILE
      IF (N.GE.MA) CALL MPACK$(301,N,MA,ERSTAT)
      IF (ERSTAT.EQ. 99) RETURN
C
C     PACK REMAINING ROWS AND COLUMNS
C
      DO 30 K=N,1,-1
        IBEG=MVALUE(K)
C
C  REDUCE SIZE OF MATRIX
C  SET IBEG =ROW, COL # OF THE MISSING VALUE AND PACK MATRIX
C  AFTER FIRST CHECKING TO ENSURE THAT IT IS VALID
C  SKIP IF NOT VALID
C
        IF (IBEG.EQ.MA) THEN
          MA=MA-1
          GOTO 30
        ELSEIF ((IBEG.GE.1) .AND. (IBEG.LT.MA)) THEN
C
C  SHIFT REMAINING COLUMNS ONE COLUMN TO THE LEFT
          DO 10 J=IBEG,MA-1
             DO 10 I=1,MA
                A(I,J)=A(I,J+1)
   10     CONTINUE
C
C  SHIFT REMAINING ROWS ONE ROW UP
          DO 20 I=IBEG,MA-1
             DO 20 J=1,MA-1
                A(I,J)=A(I+1,J)
   20     CONTINUE

C   REDUCE SIZE OF MATRIX BY ONE
          MA=MA-1
C
        ELSE
        ENDIF
   30  CONTINUE
C
      RETURN
      END
C*********************************************************************
      SUBROUTINE MPACK$(MSGCOD,UNSAM,ASIZE,ERSTAT)
C*********************************************************************
C
C   NAME- MPACK$
C
C   LANGUAGE- VS FORTRAN   TYPE- SUBROUTINE        COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 11/13/91    PROGRAMMER- TERESA SIMMS, SMSRC
C   VERSION- 3.0    DATE- 06/04/96    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 10/07/97    PROGRAMMER- LEAH WILSON (HSTX)
C
C   FILES-
C     DSN                       I/O  UNIT  FUNCTIONAL DESCRIPTION
C     ---                       ---  ----  -----------------------
C     ...KIDS                 O    KUNIT   KRAY INTERACTIVE DOCUMENTATION
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE MPACK
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY.
C   VERSION 3.1- WRITE ERROR MESSAGES TO THE KIDS FILE.  INCLUDE /SPGUNT/.
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                 INT    I   MESSAGE CODE USED TO
C                                       IDENTIFY THE ERROR PATTERN
C     UNSAM                  INT    I   NUMBER OF UNSAMPLED DATA
C                                       OBSERVATIONS
C     ASIZE                  INT    I   SIZE OF MATRIX A THAT IS
C                                       BEING PACKED
C     ERSTAT                 INT    O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O
C
      INTEGER   MSGCOD, UNSAM, ASIZE, ERSTAT
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'SPGUNT'
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
C
C   LOCAL PARAMETERS-
C     VARIABLE                TYPE    FUNCTION
C     --------                ----    --------
C     I                       INT     LOOP COUNTER
C     KMSG                   CH*100   KIDS MESSAGE BUFFER
C     C4TEMP                  CH*4    HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBROUTINES CALLED- KIDS
C
C   EXIT STATES-
C       ERSTAT = 0; INDICATING NO OR NON-FATAL ERRORS FOUND
C       ERSTAT = 99; INDICATING A FATAL ERROR WAS DETECTED
C
C*********************************************************************
C
      INTEGER   I
      CHARACTER*4   C4TEMP
      CHARACTER*100 KMSG
C
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR'
C
C   INITIALIZE VARIABLES
C
      ERSTAT=0
C
C  CHECK FOR VALID MSGCOD VALUES
C
      IF(MSGCOD.EQ.301) THEN
        KMSG(1:50)=' * NO DATA PRESENT *      missing values are >= ma'
        KMSG(51:100)='trix size of     '
        WRITE(C4TEMP,'(I4)') UNSAM 
        KMSG(22:25) = C4TEMP
        WRITE(C4TEMP,'(I4)') ASIZE
        KMSG(64:67) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = ' Invalid error message code = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END

