SUBROUTINE GLBSOI(INPREP,INGES,IIANL,JCAP,NSIG,
* NLATH,NLON,INEOFS,NITER,MITER,IOANL,A,
* ISAT,JSAT,
* ISFC,ISCRA,NBLK,ISCRA3,AMPDIVT,DAMPDIVT,IDIVT,
* ON85DT,NTDATA,NSDATA,NWDATA,NPDATA,NQDATA,NPWDAT,NQTDATA,
* NSPROF,
* ERMAXT,ERMAXW,ERMAXP,ERMAXQ,ERMAXPW,
* ERMINT,ERMINW,ERMINP,ERMINQ,ERMINPW,
* GROSST,GROSSST,GROSSW,GROSSP,GROSSQ,GROSSPW)
C--------
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . . .
C SUBPROGRAM: GLBSOI SPECTRAL OI
C PRGMMR: PARRISH ORG: W/NMC22 DATE: 90-10-06
C
C ABSTRACT: EXECUTES SPECTRAL OI ANALYSIS.
C
C PROGRAM HISTORY LOG:
C 90-10-06 PARRISH
C 94-02-11 PARRISH
C
C INPUT ARGUMENT LIST:
C INPREP - UNIT NUMBER FOR PREPDA DATA FILE.
C INGES - UNIT NUMBER FOR GUESS SPECTRAL COEFFICIENTS.
C IIANL - UNIT NUMBER FOR PREVIOUS ANALYSIS.
C JCAP - TRIANGULAR TRUNCATION
C NSIG - NUMBER OF SIGMA LEVELS
C NLATH - NUMBER OF GAUSSIAN LATS IN ONE HEMISPHERE
C NLON - NUMBER OF LONGITUDES
C INEOFS - INPUT UNIT FOR STATISTICS
C NITER - MAX NUMBER OF ITERATIONS FOR CONJUGATE GRADIENT.
C MITER - NUMBER OF OUTER ITERATIONS
C IOANL - OUTPUT UNIT FOR UPDATED ANALYSIS.
C A - A(4): SCALING FACTORS FOR FORECAST ERROR SPECTRA
C ISAT - INPUT FILE FOR SAT. ERROR COVARIANCES
C JSAT - SCRATCH FILE USED FOR SAT. DATA
C ISFC - INPUT SURFACE BGES FILE
C ISCRA - SCRATCH FILE FOR INFOR. FROM CONVENTIONAL DATA
C NBLK - BLOCKING FACTOR FOR SCRATCH FILES
C ISCRA3 - FILE TO SAVE GRID FIELDS NEEDED BY TAN LINEAR DIVT
C AMPDIVT,DAMPDIVT - PARAMETERS FOR DIVTEND PENALTY
C IDIVT - UNIT NUMBER FOR FILE WITH DIVTEND ERROR VARIANCES
C ERMAXT, ETC. - LIMITS TO OBS ERRORS FOR
C ERMINT, ETC. - GROSS ERROR CHECK
C GROSST, ETC. - TOSS LIMITS (SCALED BY OBS ERROR) FOR GROSS CHECK
C
C OUTPUT ARGUMENT LIST:
C NO OUTPUT ARGUMENTS
C
C ATTRIBUTES:
C LANGUAGE: CFT77
C MACHINE: CRAY YMP
C
C$$$
CHARACTER*4 ON85DT(8)
REAL A(4)
C--------
C-------- SCRATCH SPACE FOLLOWS
C--------
C-CRA DIMENSION RPW(2*NLATH+1,NLON+2),SIGI(NSIG+1)
C-CRA DIMENSION XHAT((JCAP+1)*(JCAP+2),NSIG,4)
C-CRA DIMENSION XHATP((JCAP+1)*(JCAP+2))
C-CRA DIMENSION DEL2((JCAP+1)*(JCAP+2))
C-CRA DIMENSION TRIGS(NLON*2),IFAX(10)
C-CRA DIMENSION RLATS(NLATH*2),SLAT(NLATH),CLAT(NLATH)
C-CRA DIMENSION WGTS(NLATH*2),SIGL(NSIG),PWCON(NSIG)
C-CRA DIMENSION ISATV(NSIG)
C-CRA DIMENSION RT(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RU(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RV(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RQ(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RP(2*NLATH+1,NLON+2)
C-CRA DIMENSION RUS(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RVS(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RTS(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RVORTS(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION RPLONS(2*NLATH+1,NLON+2)
C-CRA DIMENSION RPLATS(2*NLATH+1,NLON+2)
C-CRA DIMENSION RLSG(NSIG),AIBW(NSIG,NSIG),W(NSIG),TBAR(NSIG)
C-CRA DIMENSION A3(NSIG,NSIG),DSTLAST((JCAP+1)*(JCAP+2),NSIG)
C-CRA DIMENSION DSTB((JCAP+1)*(JCAP+2),NSIG)
C-CRA DIMENSION IN((JCAP+1)*(JCAP+2))
C-CRA DIMENSION PLN((JCAP+1)*(JCAP+2),NLATH)
C-CRA DIMENSION QLN((JCAP+1)*(JCAP+2),NLATH)
C-CRA DIMENSION RLN((JCAP+1)*(JCAP+2),NLATH)
C-CRA DIMENSION MLAD(0:JCAP,0:JCAP)
C-CRA DIMENSION ML2LM((JCAP+1)*(JCAP+2))
C-CRA DIMENSION FACTSLM((JCAP+1)*(JCAP+2))
C-CRA DIMENSION FACTVLM((JCAP+1)*(JCAP+2))
C-CRA DIMENSION LMAD(0:JCAP,0:JCAP)
C-CRA DIMENSION LM2ML((JCAP+1)*(JCAP+2))
C-CRA DIMENSION FACTSML((JCAP+1)*(JCAP+2))
C-CRA DIMENSION FACTVML((JCAP+1)*(JCAP+2))
C-CRA DIMENSION QFILE(17*NQDATA),UVFILE(18*NWDATA),TFILE(17*NTDATA)
C-CRA DIMENSION SFILE((4+(28+2)*30)*NSPROF),PWFILE(12*NPWDAT)
C-CRA DIMENSION PSFILE(11*NPDATA)
DIMENSION RPW(2*48+1,192+2),SIGI(28+1)
DIMENSION XHAT((62+1)*(62+2),28,4)
DIMENSION XHATP((62+1)*(62+2))
DIMENSION DEL2((62+1)*(62+2))
DIMENSION TRIGS(192*2),IFAX(10)
DIMENSION RLATS(48*2),SLAT(48),CLAT(48)
DIMENSION WGTS(48*2),SIGL(28),PWCON(28)
DIMENSION ISATV(28)
DIMENSION RT(2*48+1,192+2,28)
DIMENSION RU(2*48+1,192+2,28)
DIMENSION RV(2*48+1,192+2,28)
DIMENSION RQ(2*48+1,192+2,28)
DIMENSION RP(2*48+1,192+2)
DIMENSION RUS(2*48+1,192+2,28)
DIMENSION RVS(2*48+1,192+2,28)
DIMENSION RTS(2*48+1,192+2,28)
DIMENSION RVORTS(2*48+1,192+2,28)
DIMENSION RPLONS(2*48+1,192+2)
DIMENSION RPLATS(2*48+1,192+2)
DIMENSION RLSG(28),AIBW(28,28)
DIMENSION W(28),TBAR(28)
DIMENSION A3(28,28)
DIMENSION DSTLAST((62+1)*(62+2),28)
DIMENSION DSTB((62+1)*(62+2),28)
DIMENSION IN((62+1)*(62+2))
DIMENSION PLN((62+1)*(62+2),48)
DIMENSION QLN((62+1)*(62+2),48)
DIMENSION RLN((62+1)*(62+2),48)
DIMENSION MLAD(0:62,0:62)
DIMENSION ML2LM((62+1)*(62+2))
DIMENSION FACTSLM((62+1)*(62+2))
DIMENSION FACTVLM((62+1)*(62+2))
DIMENSION LMAD(0:62,0:62)
DIMENSION LM2ML((62+1)*(62+2))
DIMENSION FACTSML((62+1)*(62+2))
DIMENSION FACTVML((62+1)*(62+2))
DIMENSION QFILE(17*15000),UVFILE(18*85000)
DIMENSION TFILE(17*60000)
DIMENSION SFILE((4+(28+2)*30)*10000)
DIMENSION PWFILE(12*1)
DIMENSION PSFILE(11*18000)
C--------
C-------- SETUP VARIOUS CONSTANTS
C
C--------
C-------- SET UP INDEX ARRAYS TO CONVERT COEFS TO INTERNAL FORMAT
C--------
II=-1
DO L=0,JCAP
DO M=0,JCAP-L
II=II+2
MLAD(M,L)=II
END DO
END DO
II=-1
DO M=0,JCAP
DO L=0,JCAP-M
II=II+2
LMAD(M,L)=II
END DO
END DO
II=-1
DO M=0,JCAP
DO L=0,JCAP-M
II=II+2
ML2LM(II)=MLAD(M,L)
ML2LM(II+1)=ML2LM(II)+1
END DO
END DO
II=-1
DO L=0,JCAP
DO M=0,JCAP-L
II=II+2
LM2ML(II)=LMAD(M,L)
LM2ML(II+1)=LM2ML(II)+1
END DO
END DO
II=-1
DO M=0,JCAP
II=II+2
FACTSLM(II)=1.
FACTSLM(II+1)=0.
IF(M.LT.JCAP) THEN
DO L=1,JCAP-M
II=II+2
FACTSLM(II)=1.
FACTSLM(II+1)=1.
END DO
END IF
END DO
C-CRA FACTVLM=FACTSLM
DO I=1,(JCAP+1)*(JCAP+2)
FACTVLM(I)=FACTSLM(I)
ENDDO
FACTVLM(1)=0.
II=-1
DO L=0,JCAP
ONE=1.
ZERO=MIN(1,L)
DO M=0,JCAP-L
II=II+2
FACTSML(II)=ONE
FACTSML(II+1)=ZERO
END DO
END DO
C-CRA FACTVML=FACTSML
DO I=1,(JCAP+1)*(JCAP+2)
FACTVML(I)=FACTSML(I)
ENDDO
FACTVML(1)=0.
C------------------PICK UP HYDROSTATIC MATRIX FROM BACKGROUND STATS FILE
REWIND INEOFS
READ(INEOFS)NSIGSTAT,IDUM,NMDSZH,JCAPSTAT,
* RLSG,AIBW,W,ROGC,TBAR,A3
WRITE(6,*) 'INEOFS=',INEOFS,' READ'
CLOSE(INEOFS)
C---------------------PICK UP VERT DIM FOR SAT ER COVAR MATRICES
REWIND ISAT
READ(ISAT,5050)NSIGSAT
5050 FORMAT(1X,I3)
WRITE(6,*) 'ISAT=',ISAT,' READ'
CLOSE(ISAT)
C--------------------PICK UP VERT AND HORIZ NUMBERS FOR DIVT ERRORS
REWIND IDIVT
READ(IDIVT)NSIGDIVT,JCAPDIVT
WRITE(6,*) 'IDIVT=',IDIVT,' READ'
CLOSE(IDIVT)
II=-1
DO M=0,JCAP
DO L=0,JCAP-M
II=II+2
IN(II)=M+L
IN(II+1)=M+L
END DO
END DO
NUMCOEFS=II+1
NC=(JCAP+1)*(JCAP+2)
WRITE(6,*)' (JCAP+1)*(JCAP+2)=',NC,' NUMCOEFS=',NUMCOEFS
C---------------------TEST VARIOUS ADJOINTS
C CALL TSTHOPER(INEOFS,PWCON,JCAP,NSIG,NLATH,NLON,AP,BP,AQR,
C * BQR,GR,DEL2,WGTS,SLAT,CLAT,TRIGS,IFAX,PE0,QE0,RO0,LMIX,
C * LASTMIX,LPAIRS,IN,RLATS,RT,RU,RV,RQ,RP,
C * NSIGSTAT,NMDSZH,JCAPSTAT,A)
C----------------------
C--------
C-------- INITIALIZE VARIOUS TRANSFORM CONSTANTS
C-------- READ DATA, DO VARIOUS STUFF, OUTPUT F0 AND
C-------- INVERSE OF SUPEROB ERROR VARIANCES
C--------
DO JITER=1,MITER
INEXT=INGES
IF(JITER.GT.1) INEXT=IOANL
CALL SETUPRHS(SIGL,JITER,RPW,SIGI,
* INEXT,IIANL,JCAP,NSIG,
* NLATH,NLON,PWCON,
* NTDATA,NSDATA,NWDATA,NPDATA,NQDATA,NPWDAT,NQTDATA,
* NTRECS,NWRECS,NPRECS,NQRECS,NPWRECS,
* ISAT,NSIGSAT,JSAT,MSAT,
* RLATS,DEL2,PLN,QLN,RLN,WGTS,TRIGS,IFAX,IN,
* ISFC,ISATV,ISCRA,NBLK,RT,RU,RV,RQ,RP,
* A3,AMPDIVT,DAMPDIVT,DSTLAST,DSTB,ISCRA3,
* ERMAXT,ERMAXW,ERMAXP,ERMAXQ,ERMAXPW,
* ERMINT,ERMINW,ERMINP,ERMINQ,ERMINPW,
* GROSST,GROSSST,GROSSW,GROSSP,GROSSQ,GROSSPW,
* MLAD,ML2LM,FACTSLM,FACTVLM,
* LMAD,LM2ML,FACTSML,FACTVML,
* RUS,RVS,RTS,RVORTS,RPLONS,RPLATS,
* QFILE,UVFILE,TFILE,SFILE,PWFILE,PSFILE,NSPROF)
C--------
C-------- SOLVE OI EQUATION, ADD INCREMENT TO GUESS COEFS AND
C-------- WRITE OUT.
C--------
CALL PCGSOI(INEOFS,XHAT,XHATP,PWCON,JSAT,MSAT,
* NITER,MITER,JITER,JCAP,NSIG,NLATH,
* NLON,DEL2,WGTS,PLN,QLN,RLN,TRIGS,IFAX,IN,ISATV,
* NTDATA,NWDATA,NPDATA,NQDATA,NPWDAT,
* NTRECS,NWRECS,NPRECS,NQRECS,NPWRECS,
* ISCRA,NBLK,ON85DT,IOANL,INEXT,INGES,RLATS,A,RT,RU,RV,RPW,RQ,RP,
* NSIGSTAT,NMDSZH,JCAPSTAT,AMPDIVT,DAMPDIVT,IDIVT,
* NSIGDIVT,JCAPDIVT,A3,SIGL,SIGI,DSTLAST,DSTB,ISCRA3,RRM0,
* MLAD,ML2LM,FACTSLM,FACTVLM,
* LMAD,LM2ML,FACTSML,FACTVML,
* RUS,RVS,RTS,RVORTS,RPLONS,RPLATS,
* QFILE,UVFILE,TFILE,SFILE,PWFILE,PSFILE,NSPROF)
END DO
RETURN
END