      SUBROUTINE BLDCMP(RETFLG,CHNCMB,CHNCMH,CHNCH2,HIGH,HIGH2,HIGH3,
     &CLDCHN,CHNUNC,AVNSTR,ASAT,RTCMPG)
C*********************************************************************
C
C   NAME- BLDCMP
C
C   LANGUAGE- VS FORTRAN    TYPE- SUBROUTINE    COMPUTER- HDS9000
C
C   VERSION- 1.0      DATE- 11/20/91   PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 3.0      DATE- 06/03/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1      DATE- 06/07/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.2      DATE- 05/08/97   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.3      DATE- 08/27/98   PROGRAMMER- M.P. FERGUSON (RSTX)
C   VERSION- 3.4      DATE- 06/15/99   PROGRAMMER- M.P. FERGUSON (RSTX)
C   VERSION- 3.5      DATE- 08/30/99   PROGRAMMER- M.P. FERGUSON (RSTX)
C   VERSION- 3.6      DATE- 05/03/00   PROGRAMMER- M.P. FERGUSON (RITSS).
C   VERSION- 3.7      DATE- 07/21/00   PROGRAMMER- M.P. FERGUS0N (RITSS).
C   VERSION- 3.8      DATE- 12/19/01   PROGRAMMER- M.P. FERGUSON (RITSS).
C
C   FUNCTION-  THIS SUBROUTINE COMPUTES THE RETRIEVAL OPERATOR COMPONENT
C              G.  FIRST, THE NOISE COVARIANCE MATRIX IS COMPUTED FROM
C              THE CHANNEL MEASUREMENT UNCERTAINTIES AND THE AVERAGE
C              NSTAR VALUE (IF THE DATA HAS BEEN CLOUD-CLEARED).  THEN
C              THE NOISE COVARIANCE MATRIX IS ADDED TO THE RETRIEVAL
C              OPERATOR COMPONENT ASA-TRANSPOSE.  THE INVERSE OF THE
C              SUM IS THEN TAKEN TO GET THE RETRIEVAL OPERATOR COMPONENT
C              G.
C
C   VERSION- 3.0 DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE ON
C                THE CRAY
C   VERSION- 3.1 ADDED EXTRA ARGUMENT FOR CRAY VERSION OF DLINDS.
C   VERSION- 3.2 MODIFICATIONS FOR HIGH TERRAIN RETRIEVAL UPGRADE.
C   VERSION- 3.3 CODE MODIFED TO OBTAIN THE MODIFIED CHANNEL COMBINA-
C                TION FOR HIGH TERRAIN RETRIEVALS (CHNCMH) FROM THE CDB
C                VIA THE INPUT ARGUMENT LIST.  CHNCMH ADDED TO LIST OF
C                CALLING PARAMETERS.
C   VERSION- 3.4 CODE MODIFIED TO EXCLUDE AMSU-6 IN THE RETRIEVAL IF A
C                HIGH TERRAIN LOCATION IS SOUTH OF -60 S.
C   VERSION- 3.5 DISUSE OF AMSU-A 4 AND 5 DUE TO ICE AND SNOW PRESENCE 
C                DISCONTINUED.
C   VERSION- 3.6 CODE MODIFIED TO USE A DIFFERENT HIGH TERRAIN CHANNEL
C                COMBINATION IF THE TERRAIN HEIGHT IS ABOVE 2500 M.
C   VERSION- 3.7 ADJUSTED CODE TO ALLOW FOR USE OF CLOUDY CHANNEL COM-
C                BINATION ABOVE A CERTAIN HEIGHT, AND ONLY DEGRADE THIS
C                COMBINATION IF THE HEIGHT EXCEEDS LIMHG2 OR LIMHGT. THIS
C                HEIGHT IS CLRHGT.  LOGICAL FLAGS HIGH, HIGH2, AND HIGH3 
C                REDEFINED AND HIGH4 ELIMINATED.
C   VERSION- 3.8 CORRECT CODE TO ALLOW FOR CORRECT CHANNEL COMBINATION
C                USAGE WHEN "HIGH3" IS SET BUT "HIGH2" IS NOT WR # 183).
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   RETFLG  INT     I    RETRIEVAL FLAG INDICATING THE CLOUD-CLEARING
C                        RETRIEVAL METHOD:
C                         RETFLG = CLOUD-CLEARING CONDITION * 16
C                                   + RETRIEVAL METHOD
C                        WHERE-
C                         CLOUD CLEARING CONDITION OF 0 = CLEAR,
C                         1 = CLOUD-CLEARED, 2 = CLOUDY
C   CHNCMB  INT     I    ARRAY (DIM 2) CONTAINING BIT FLAGS FOR CHANNELS
C                        NEEDED TO MAKE A RETRIEVAL
C   HIGH    LOG     I    VALUE IS TRUE FOR A HIGH TERRAIN RETREIVAL ABOVE
C                        CLRHGT.
C   HIGH2   LOG     I    VALUE IS TRUE FOR A HIGH TERRAIN RETRIEVAL ABOVE
C                        LIMHGT.  
C   HIGH3   LOG     I    VALUE IS TRUE FOR A HIGH TERRAIN RETRIEVAL ABOVE
C                        LIMHG2.  
C   CLDCHN  INT     I    ARRAY (DIM 2) CONTAINING BIT FLAGS FOR
C                        INSTRUMENT CHANNELS AFFECTED BY CLOUDS
C   CHNUNC  REAL    I    ARRAY (DIM NUMCHN) OF CHANNEL MEASUREMENT
C                        UNCERTAINTIES ASSOCIATED WITH THE CLASS AND
C                        PATH
C   AVNSTR  REAL    I    AVERAGE NSTAR VALUE FOR THE RETRIEVAL (THIS
C                        WILL ONLY CONTAIN A VALUE IF THE CLOUD-CLEARING
C                        CONDITION IS CLOUD-CLEARED)
C   ASAT    REAL    I    MATRIX (DIM NUMCHN X NUMCHN) CONTAINING
C                        RETRIEVAL OPERATOR COMPONENT ASA-TRANSPOSE
C   RTCMPG  REAL    O    MATRIX (DIM NUMCHN X NUMCHN) WHICH IS THE
C                        INVERSE OF THE SUM OF ASAT AND THE COMPUTED
C                        NOISE COVARIANCE MATRIX
C
C   LOCAL VARIABLES-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   I,J     INT    DO LOOP VARIABLES
C   CHAN    INT    DO LOOP VARIABLE FOR CHANNEL
C   NCOVMX  REAL   MATRIX (DIM NUMCHN X NUMCHN) CONTAINING TRIDIAGONAL
C                  NOISE COVARIANCE MATRIX
C   GINVRS  REAL   MATRIX (DIM NUMCHN X NUMCHN) CONTAINING INVERSE
C                  OF RTCMPG MATRIX
C   HIGH    LOG    HIGH TERRAIN RETRIEVAL FLAG.
C   MLTPLY  REAL   MULTIPLIER TO USE IN ADJUSTMENTS OF NOISE COVARIANCE
C                  MATRIX FOR CLOUD-CLEARED RADIANCES
C   MLTARY  REAL   ARRAY (DIM NUMCHN) CONTAINING ELEMENTS EQUAL TO
C                  MLTPLY FOR ELEMENTS CORRESPONDING TO CHANNELS
C                  AFFECTED BY CLOUDS, OTHERWISE ELEMENTS ARE SET TO 1.
C   FLAG    INT    BIT FLAG TO CHECK USING BTEST
C   BIT     INT    SPECIFIC BIT IN BIT FLAG TO CHECK USING BTEST
C   ELEM    INT    NUMBER OF ELEMENTS FILLED IN NOTUSE ARRAY
C   NOTUSE  INT    ARRAY (DIM NUMCHN) OF CHANNELS NOT USED IN MAKING
C                  A RETRIEVAL - NEEDED FOR PACKING AND UNPACKING
C                  MATRIX FOR COMPUTING INVERSE
C   TMPCMB  INT    ARRAY (DIM 2) CONTAINING THE LOCAL RETRIEVAL CHANNEL
C                  COMBINATION BIT FLAGS.
C   PAKDIM  INT    DIMENSION OF PACKED MATRIX
C   STATUS  INT    STATUS RETURNED FROM MPACK AND MUNPK
C   INFO    INT    RETURN CODE FROM DLINDS.
C
C
C   SUBPROGRAMS CALLED- MADD, MPACK, DLINDS, MUNPK
C
C   FUNCTIONS USED- SQRT, BTEST
C
C   EXIT STATES- NONE
C
C*********************************************************************
C
      INCLUDE 'CLDDAT'
      INCLUDE 'RETPARM'
C
      INTEGER RETFLG, CHNCMB(2), CLDCHN(2), CHAN, FLAG, BIT, INFO
      INTEGER CHNCMH(2),CHNCH2(2)
      INTEGER NOTUSE(NUMCHN), TMPCMB(2), PAKDIM, ELEM, I, J, STATUS
C
      REAL CHNUNC(NUMCHN), AVNSTR, ASAT(NUMCHN,NUMCHN)
      REAL RTCMPG(NUMCHN,NUMCHN), NCOVMX(NUMCHN,NUMCHN)
      REAL MLTARY(NUMCHN), MLTPLY, GINVRS(NUMCHN,NUMCHN)
C
      LOGICAL HIGH, HIGH2, HIGH3
C
C  USE LOCAL VARIABLES IN CASE CHANNEL COMBINATION MUST BE CHANGED
C
      TMPCMB(1) = CHNCMB(1)
      TMPCMB(2) = CHNCMB(2)
C
C  INITIALIZE NOISE COVARIANCE MATRIX TO ALL ZEROS.
C
      DO 20 I = 1, NUMCHN
        DO 10 J = 1, NUMCHN
          NCOVMX(I,J) = 0.0
   10   CONTINUE
   20 CONTINUE
C
C  COMPUTE THE TRI-DIAGONAL NOISE COVARIANCE MATRIX.
C
      DO 30 CHAN = 1, NUMCHN
        NCOVMX(CHAN,CHAN) = (CHNUNC(CHAN))**2
        IF (CHAN .LT. NUMCHN) THEN
          NCOVMX(CHAN,CHAN+1) = (CHNUNC(CHAN) * CHNUNC(CHAN+1)) / 4.0
          NCOVMX(CHAN+1,CHAN) = NCOVMX(CHAN,CHAN+1)
        ENDIF
   30 CONTINUE
C
C  MAKE ADJUSTMENTS TO TRI-DIAGONAL NOISE COVARIANCE MATRIX FOR
C  CLOUD CLEARED RADIANCES IF NEEDED.
C
      IF (RETFLG/16 .EQ. 1) THEN
        MLTPLY = SQRT((1 + AVNSTR**2) / (1 - AVNSTR**2))
C
        DO 40 CHAN = 1, NUMCHN
          IF (CHAN .LE. 20) THEN
            FLAG = CLDCHN(1)
            BIT = 32 - CHAN
          ELSE
            FLAG = CLDCHN(2)
            BIT = 32 - CHAN + 20
          ENDIF
          IF (BTEST(FLAG, BIT)) THEN
            MLTARY(CHAN) = MLTPLY
          ELSE
            MLTARY(CHAN) = 1.0
          ENDIF
   40   CONTINUE
C
        DO 50 CHAN = 1, NUMCHN
          NCOVMX(CHAN,CHAN) = NCOVMX(CHAN,CHAN) * (MLTARY(CHAN)**2)
          IF (CHAN .LT. NUMCHN) THEN
            NCOVMX(CHAN,CHAN+1) = NCOVMX(CHAN,CHAN+1) * (MLTARY(CHAN)*
     1                            MLTARY(CHAN+1))
            NCOVMX(CHAN+1,CHAN) = NCOVMX(CHAN,CHAN+1)
          ENDIF
   50   CONTINUE
C
      ENDIF
C
C  ADD THE NOISE COVARIANCE MATRIX TO ASA-TRANSPOSE TO GET GINVRS.
C
      CALL MADD(ASAT,NCOVMX,GINVRS,NUMCHN,NUMCHN)
C
C  ADJUST THE RETRIEVAL COMBINATION BIT FLAGS FOR HIGH TERRAIN
C  RETRIEVALS.  TAKE OUT CHANNEL 22, AND 8.
C
C************** FOR NOAA-K *********************
C     THIS NEEDS TO BE ADJUSTED TO ELIMINATE LOW PEAKING AMSU-A
C     CHANNELS (CHAN. 22 CURRENTLY REFERS TO MSU-2)
C***********************************************
      IF (HIGH2) THEN
        TMPCMB(2) = CHNCMH(2)         
        TMPCMB(1) = CHNCMH(1)          
      ENDIF
CCMPF   print *, '*******high terrain retrieval, chancomb = *******',    
CCMPF+  chncmh(1),chncmh(2)
      IF (HIGH3) THEN
        TMPCMB(2) = CHNCH2(2)
        TMPCMB(1) = CHNCH2(1)
CCMPF   print *, '*******high2 terr retrieval, chancomb = *******',    
CCMPF+  chnch2(1),chnch2(2)
      ENDIF
C
C OVER ICE AND OVER SNOW RETRIEVALS SHOULD NOT USE AMSU 4 OR 5.
C
CCMPF IF (.NOT.ICEFRE.OR..NOT.SNWFRE)THEN
CCMPF   TMPCMB(2) = IBCLR(TMPCMB(2),27)
CCMPF   TMPCMB(2) = IBCLR(TMPCMB(2),28)
CCMPF ENDIF
C
C FOR HIGH TERRAIN LOCATIONS S OF -60 S, ASSURE THAT AMSU-6 NOT USED IN 
C RETRIEVAL.
C
CCMPF IF (HIGH2) THEN
CCMPF    TMPCMB(2) = IBCLR(TMPCMB(2),26)
CCMPF    print *, '****high 2 invoked, S of -60 S***,chancomb = ',
CCMPF+   tmpcmb(1),tmpcmb(2)
CCMPF ENDIF
C
C FOR LAND LOCATIONS S OF -60 S, ASSURE THAT AMSU-5 NOT USED IN RETRIEVAL.
C
CCMPF IF (HIGH3) THEN
CCMPF    TMPCMB(2) = IBCLR(TMPCMB(2),27)
CCMPF    print *, '****high 3 invoked, S of -60 S***,chancomb = ',
CCMPF+   tmpcmb(1),tmpcmb(2)
CCMPF ENDIF
C
C  CREATE VECTOR CONTAINING CHANNELS NOT USED IN MAKING A RETRIEVAL
C  TO USE IN COMPRESSION AND EXPANSION OF MATRICES.
C
      ELEM = 0
      DO 60 CHAN = 1, NUMCHN
        IF (CHAN .LE. 20) THEN
          FLAG = TMPCMB(1)
          BIT = 32 - CHAN
        ELSE
          FLAG = TMPCMB(2)
          BIT = 32 - CHAN + 20
        ENDIF
        IF (.NOT.(BTEST(FLAG, BIT))) THEN
          ELEM = ELEM + 1
          NOTUSE(ELEM) = CHAN
        ENDIF
   60 CONTINUE
C
C  COMPRESS GINVRS TO INCLUDE VALUES ONLY FOR ROWS AND COLUMNS
C  THAT CORRESPOND TO CHANNELS NEEDED FOR MAKING A RETRIEVAL.
C
      PAKDIM = NUMCHN
C
      CALL MPACK(GINVRS,NUMCHN,PAKDIM,NOTUSE,ELEM,STATUS)
C
C  COMPUTE INVERSE OF COMPRESSED MATRIX USING ROUTINE DLINDS.
C
      CALL DLINDS(PAKDIM,GINVRS,NUMCHN,RTCMPG,NUMCHN,INFO)
C
C  EXPAND RTCMPG SO THAT ROWS AND COLUMNS CORRESPONDING TO CHANNELS
C  NOT USED IN MAKING A RETRIEVAL ARE FILLED WITH ZEROS.
C
      CALL MUNPK(RTCMPG,NUMCHN,PAKDIM,NOTUSE,ELEM,STATUS)
C
      RETURN
      END
