SUBROUTINE QOPER(U,V,VORT,T,PLON,PLAT,NSIG,JCAP,NLON,NLATH,
* PLN,QLN,RLN,TRIGS,IFAX,DEL2,WGTS,A3,SIGL,SIGI,DS,IBACK,RLATS,
* RUS,RVS,RTS,RVORTS,RPLONS,RPLATS)
C-------------------
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . . .
C SUBPROGRAM: QOPER TANGENT LINEAR MODEL FOR DIVERGENCY TENDENCY
C PRGMMR: PARRISH ORG: W/NMC22 DATE: 94-02-12
C
C ABSTRACT: TANGENT LINEAR MODEL (TLM) FOR DIVERGENCE TENDENCY.
C SPECIAL NOTE: VERTICAL ADVECTION TERMS NOT INCLUDED YET
C----- (THEY ARE INCLUDED IN FULLDIVT COMPUTATION)
C
C PROGRAM HISTORY LOG:
C 94-02-12 PARRISH
C
C INPUT ARGUMENT LIST:
C U,V,VORT,T,PLON,PLAT - PERTURBATION U,V, ETC. ON GAUSSIAN GRID
C NSIG - NUMBER OF SIGMA LAYERS
C JCAP - TRIANGULAR TRUNCATION
C NLON - NUMBER OF LONGITUDES
C NLATH - NUMBER OF GAUSSIAN LATS IN ONE HEMISPHERE
C PLN,QLN,RLN - SPHERICAL HARMONICS
C TRIGS,IFAX - USED BY FFT
C DEL2 - N*(N+1)/A**2
C WGTS - GAUSSIAN INTEGRATION WEIGHTS
C A3 - HYDROSTATIC MATRIX
C SIGL,SIGI - VERTICAL COORDINATE STUFF
C IBACK - UNIT NUMBER WHERE REFERENCE FIELDS ARE STORED
C
C OUTPUT ARGUMENT LIST:
C DS - PERTURBATION DIVERGENCE TENDENCY COEFFICIENTS
C
C ATTRIBUTES:
C LANGUAGE: CFT77
C MACHINE: CRAY YMP
C
C$$$
C
C-CRA DIMENSION SIGL(NSIG),SIGI(NSIG+1)
C-CRA DIMENSION A3(NSIG,NSIG)
C-CRA DIMENSION DEL2((JCAP+1)*(JCAP+2))
C-CRA DIMENSION WGTS(2*NLATH)
C-CRA DIMENSION U(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION V(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION VORT(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION PLON(2*NLATH+1,NLON+2)
C-CRA DIMENSION PLAT(2*NLATH+1,NLON+2)
C-CRA DIMENSION TRIGS(NLON*2),IFAX(10)
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 DS((JCAP+1)*(JCAP+2),NSIG)
C-CRA DIMENSION RLATS(2*NLATH)
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 TS((JCAP+1)*(JCAP+2),NSIG)
C-CRA DIMENSION PS((JCAP+1)*(JCAP+2))
C-CRA DIMENSION UW(2*NLATH+1,NLON+2,NSIG),VW(2*NLATH+1,NLON+2,NSIG)
C-CRA DIMENSION PW(2*NLATH+1,NLON+2)
C-CRA DIMENSION CORIOLIS(2*NLATH+1,NLON+2)
C-CRA REAL T(2*NLATH+1,NLON+2,NSIG)
DIMENSION SIGL(28),SIGI(28+1)
DIMENSION A3(28,28)
DIMENSION DEL2((62+1)*(62+2))
DIMENSION WGTS(2*48)
DIMENSION U(2*48+1,192+2,28)
DIMENSION V(2*48+1,192+2,28)
DIMENSION VORT(2*48+1,192+2,28)
DIMENSION PLON(2*48+1,192+2)
DIMENSION PLAT(2*48+1,192+2)
DIMENSION TRIGS(192*2),IFAX(10)
DIMENSION PLN((62+1)*(62+2),48)
DIMENSION QLN((62+1)*(62+2),48)
DIMENSION RLN((62+1)*(62+2),48)
DIMENSION DS((62+1)*(62+2),28)
DIMENSION RLATS(2*48)
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 TS((62+1)*(62+2),28)
DIMENSION PS((62+1)*(62+2))
DIMENSION UW(2*48+1,192+2,28),VW(2*48+1,192+2,28)
DIMENSION PW(2*48+1,192+2)
DIMENSION CORIOLIS(2*48+1,192+2)
REAL T(2*48+1,192+2,28)
C--------
C-------- INTERNAL SCRATCH DYNAMIC SPACE FOLLOWS:
C--------
C--------
NG=(2*NLATH+1)*NLON
NC=(JCAP+1)*(JCAP+2)
OMEGA=CONMC('OMEGA$')
GASCON=CONMC('RD$')
EACCEL=9.8
DO J=1,2*NLATH
C-CRA CORIOLIS(J,1:NLON)=2.*OMEGA*SIN(RLATS(J))
DO ITMP=1,NLON
CORIOLIS(J,ITMP)=2.*OMEGA*SIN(RLATS(J))
END DO
C--------
C-------- COMPUTE UD,VD, BIGE
C------------------------COMPUTE FULL NON-LIN BAL EQ
DO K=1,NSIG
DO I=1,NLON
UW(J,I,K)=-GASCON*T(J,I,K)*RPLONS(J,I)
* -GASCON*RTS(J,I,K)*PLON(J,I)
* +RVS(J,I,K)*VORT(J,I,K)
* +V(J,I,K)*(RVORTS(J,I,K)+CORIOLIS(J,I))
VW(J,I,K)=-RUS(J,I,K)*VORT(J,I,K)
* -GASCON*T(J,I,K)*RPLATS(J,I)
* -GASCON*RTS(J,I,K)*PLAT(J,I)
* -U(J,I,K)*(RVORTS(J,I,K)+CORIOLIS(J,I))
VORT(J,I,K)=U(J,I,K)*RUS(J,I,K)
* +V(J,I,K)*RVS(J,I,K)
END DO
END DO
DO K=1,NSIG
DO L=1,NSIG
DO I=1,NLON
VORT(J,I,K)=VORT(J,I,K)+EACCEL*A3(K,L)*T(J,I,L)
END DO
END DO
END DO
END DO
C---------
C--------- NOW GET DIV (UD,VD) - DEL2 (BIGE) (BIGE STORED IN VORT)
C---------
DO K=1,NSIG
CALL G2S0(TS(1,K),VORT(1,1,K),JCAP,NLON,NLATH,
* WGTS,PLN,TRIGS,IFAX)
CALL GRAD2S(DS(1,K),UW(1,1,K),VW(1,1,K),JCAP,NLON,NLATH,
* QLN,RLN,TRIGS,IFAX,WGTS,DEL2)
C-CRA TS(1:NC,K)=DEL2(1:NC)*TS(1:NC,K)
DO ITMP=1,NC
TS(ITMP,K)=DEL2(ITMP)*TS(ITMP,K)
END DO
C-CRA DS(1:NC,K)=DS(1:NC,K)+TS(1:NC,K)
DO ITMP=1,NC
DS(ITMP,K)=DS(ITMP,K)+TS(ITMP,K)
END DO
END DO
RETURN
END