SUBROUTINE SATOP4(MSAT,NLATH,NLON,NSIG,RT,CSHAT,
     *    PLN,TRIGS,IFAX,JCAP,ISATV,SFILE)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    SATOP4     MULTIPLY BY INVERSE OF SAT COV. MATRIX
C   PRGMMR: PARRISH          ORG: W/NMC22    DATE: 90-10-11
C
C ABSTRACT: MULTIPLY T BY INVERSE OF SAT. ERROR COVARIANCE MATRIX.
C     I.E., INCLUSION OF VERTICALLY CORRELATED ERROR
C
C PROGRAM HISTORY LOG:
C   90-10-11  PARRISH
C   92-07-21
C
C   INPUT ARGUMENT LIST:
C     MSAT     - NUMBER OF SATELLITE PROFILES               
C     NLATH    - NUMBER OF GAUSSIAN LATS IN ONE HEMISPHERE
C     NLON     - NUMBER OF LONGITUDES
C     NSIG     - NUMBER OF SIGMA LEVELS
C     RT       - INPUT TEMPERATURE CORRECTION FIELD        
C     CSHAT    - DIAGONAL SPECTRAL ERROR COVARIANCE MATRIX (INVERSE)
C     PLN      - SPHERICAL HARMONICS
C     TRIGS,IFAX - USED BY FFT
C     JCAP     - SPECTRAL TRUNCTATION
C     ISATV    - ARRAY FLAGS FOR USE OF SAT. COVARIANCE
C     ISCRA    - UNIT NUMBER FOR CONVENTIONAL SCRATCH UNIT
C
C   OUTPUT ARGUMENT LIST:
C     RT       - OUTPUT VECTOR AFTER INCLUSION OF SAT. INFO.
C
C ATTRIBUTES:
C   LANGUAGE: CFT77
C   MACHINE:  CRAY YMP
C
C$$$
C--------
C-------- MULTIPLY INPUT VECTOR T BY INVERSE OF CORRELATED OBS ERROR
C--------
C
C-CRA          DIMENSION CSHAT((JCAP+1)*(JCAP+2)),ISATV(NSIG)
C-CRA          DIMENSION TRIGS(NLON*2),IFAX(10)
C-CRA          DIMENSION SFILE(*)
C-CRA          REAL RT(2*NLATH+1,NLON+2,NSIG)
C-CRA          REAL PLN((JCAP+1)*(JCAP+2),NLATH)
C-CRA          REAL RR(2*NLATH+1,NLON+2,NSIG)
C-CRA          REAL ST(2*NLATH+1,NLON+2,NSIG)
 
          DIMENSION CSHAT((62+1)*(62+2)),ISATV(28)
          DIMENSION TRIGS(192*2),IFAX(10)
          DIMENSION SFILE(*)
          REAL RT(2*48+1,192+2,28)
          REAL PLN((62+1)*(62+2),48)
          REAL RR(2*48+1,192+2,28)
          REAL ST(2*48+1,192+2,28)
C--------
C-------- LOCAL SPACE
C
C     DIMENSION INDL(NSIG)
      NGRD=(2*NLATH+1)*(NLON+2)
C-CRA                ST=RT
C       REAL ST(2*NLATH+1,NLON+2,NSIG)
          DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG
          ST(ITMP,1,1)=RT(ITMP,1,1)
          ENDDO
C-CRA                RT=0.
C       REAL RT(2*NLATH+1,NLON+2,NSIG)
          DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG
          RT(ITMP,1,1)=0.
          ENDDO
      IF(MSAT .EQ. 0)GO TO 440
C-CRA                RR=0.
C       REAL RR(2*NLATH+1,NLON+2,NSIG)
          DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG
          RR(ITMP,1,1)=0.
          ENDDO
      IACNT=0
      DO 610 LL=1,MSAT
      IACNT=IACNT+1
      NUMT=SFILE(IACNT)
      DO 602 LLL=1,NUMT
C     NLEVS=SFILE(1+IACNT)
      JLAT=SFILE(1+IACNT)
      JLON=SFILE(2+IACNT)
      IBEG=SFILE(3+IACNT)
      IACNT=IACNT+3+NSIG
      NXIG=NSIG-IBEG+1
      CALL SGEMV('T',NXIG,NXIG,1.,SFILE(IACNT+1),NXIG,
     *     ST(JLAT,JLON,IBEG),NGRD,1.,RR(JLAT,JLON,IBEG),NGRD)
C     DO 644 N=1,NLEVS
C44   INDL(N)=SFILE(IACNT+N)
C     IACNT=IACNT+2*NLEVS
C     DO 133 LLM=1,NSIG
C     DO 133 LLX=1,NSIG
C     RR(JLAT,JLON,LLM)=RR(JLAT,JLON,LLM)+
C    *     ST(JLAT,JLON,LLX)
C    *     *SFILE((LLM-1)*NSIG+LLX+IACNT)
C133  CONTINUE
      IACNT=IACNT+NSIG*NSIG
 602  CONTINUE
 610  CONTINUE
 611  CONTINUE
      CALL SATC(RR,NSIG,JCAP,NLON,NLATH,
     *            PLN,TRIGS,IFAX,CSHAT,ISATV)
      IACNT=0
      DO 510 LL=1,MSAT
      IACNT=IACNT+1
      NUMT=SFILE(IACNT)
      DO 102 LLL=1,NUMT
C     NLEVS=SFILE(1+IACNT)
      JLAT=SFILE(1+IACNT)
      JLON=SFILE(2+IACNT)
      IBEG=SFILE(3+IACNT)
      IACNT=IACNT+3+NSIG
      NXIG=NSIG-IBEG+1
      CALL SGEMV('N',NXIG,NXIG,1.,SFILE(IACNT+1),NXIG,
     *     RR(JLAT,JLON,IBEG),NGRD,1.,RT(JLAT,JLON,IBEG),NGRD)
C     DO 44 N=1,NSIGS
C4    INDL(N)=SFILE(IACNT+N)
C     IACNT=IACNT+2*NLEVS
C     DO 1133 LLM=1,NSIG
C     DO 1133 LLX=1,NSIG
C     RT(JLAT,JLON,LLM)=RT(JLAT,JLON,LLM)+
C    *     RR(JLAT,JLON,LLX)*SFILE((LLX-1)*NSIG+LLM+IACNT)
C133  CONTINUE
      IACNT=IACNT+NSIG*NSIG
 102  CONTINUE
 510  CONTINUE
 511  CONTINUE
440   CONTINUE
      RETURN
      END