SUBROUTINE INITSAT(MSAT,NLATH,NLON,NSIG,RT,CSHAT,PLN, * TRIGS,IFAX,JCAP,ISATV,SFILE) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: INITSAT SETUP INITIAL RHS FOR SAT. TEMPS C PRGMMR: PARRISH ORG: W/NMC22 DATE: 90-10-11 C C ABSTRACT: SETUP INITIAL RHS FOR SAT. TEMPS INCLUDE HORIZONTALLY C AND 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 CSHAT - DIAGONAL SPECTRAL ERROR COVARIANCE MATRIX (INVERSE) C PLN - P(N,L) 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 NTRECS - NUMBER OF RECORDS OF CONVENTIONAL TEMPERATURES 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 DIMENSION TVAL(NSIG) 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) DIMENSION CSHAT((62+1)*(62+2)),ISATV(28) DIMENSION TRIGS(192*2),IFAX(10) DIMENSION SFILE(*) DIMENSION TVAL(28) REAL RT(2*48+1,192+2,28) REAL PLN((62+1)*(62+2),48) REAL RR(2*48+1,192+2,28) C-------- C-------- LOCAL SPACE C------- C DIMENSION INDL(NSIG) C-------- NGRD=(2*NLATH+1)*(NLON+2) 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 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 IF(MSAT .EQ. 0)GO TO 440 IACNT=0 DO 610 LL=1,MSAT IACNT=IACNT+1 NUMT=SFILE(IACNT) PRINT *,NUMT 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 NXIG=NSIG-IBEG+1 CALL SGEMV('T',NXIG,NXIG,-1.,SFILE(IACNT+1+NSIG),NXIG, * SFILE(IACNT+1),1,1.,RR(JLAT,JLON,IBEG),NGRD) C DO 644 N=1,NSIG C44 TVAL(N)=SFILE(IACNT+N) C IACNT=IACNT+NSIG C DO 133 LLM=1,NSIG C DO 133 LLX=1,NSIG C RR(JLAT,JLON,LLM)=RR(JLAT,JLON,LLM)- C * TVAL(LLX) C * *SFILE((LLM-1)*NSIG+LLX+IACNT) C133 CONTINUE C IACNT=IACNT+NSIG*NSIG IACNT=IACNT+NSIG*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 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