SUBROUTINE INGUESSV(GU,GV,GT,GP,GQ,GMTNS,SIGI,SIGL, * INGES,JCAP,NSIG,NLATH,NLON,HOURG,IDATEG, * VORTB,DIVB,PLONB,PLATB,DEL2,PLN,QLN,RLN,TRIGS,IFAX, * ML2LM,FACTSLM,FACTVLM) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: INGUESSV SAME AS INGUESS, BUT ADD VORT,DIV, DEL(PS) C PRGMMR: PARRISH ORG: W/NMC22 DATE: 94-02-11 C C ABSTRACT: AUGMENT INGUESS WITH VORT, DIV, GRAD (LOG(PSFC)) C C PROGRAM HISTORY LOG: C 94-02-11 PARRISH C C INPUT ARGUMENT LIST: C INGES - UNIT NUMBER OF GUESS COEFS 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 AP,BP,AQR,BQR,GR - RECURSION CONSTANTS FOR SPHERICAL HARMONICS C SLAT,CLAT - SIN AND COS OF GAUSSIAN LATITUDES C PE0,QE0,RO0 - STARTING FUNCTIONF FOR SPHERICAL HARMONIC RECURSIONS C TRIGS,IFAX - USED BY C DEL2 - N*(N+1)/A**2 C C OUTPUT ARGUMENT LIST: C GU - GUESS U ON GRID C GV - GUESS V ON GRID C GT - GUESS T ON GRID C GP - GUESS LOG(SFCP) ON GRID C GQ - GUESS SPECIFIC HUMIDITY ON GRID C GMTNS - GUESS MOUNTAINS C VORTB,DIVB, PLONB,PLATB - GUESS VORT,DIV, GRAD(LOG(PSFC)) C SIGI - SIGMA VALUES AT INTERFACES OF SIGMA LAYERS C SIGL - SIGMA VALUES AT MID-POINT OF EACH SIGMA LAYER C HOURG - HOUR OF GUESS FIELD C IDATEG - DATE OF GUESS FIELD C C ATTRIBUTES: C LANGUAGE: CFT77 C MACHINE: CRAY YMP C C$$$ C C-CRA DIMENSION GU(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION GV(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION GT(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION GP(2*NLATH+1,NLON+2) C-CRA DIMENSION PLONB(2*NLATH+1,NLON+2) C-CRA DIMENSION PLATB(2*NLATH+1,NLON+2) C-CRA DIMENSION GQ(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION VORTB(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION DIVB(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION GMTNS(2*NLATH+1,NLON+2) C-CRA DIMENSION SIGL(NSIG),SIGI(NSIG+1) C-CRA DIMENSION DEL2((JCAP+1)*(JCAP+2)) C-CRA DIMENSION TRIGS(NLON*2),IFAX(10) 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 REAL ZC((JCAP+1)*(JCAP+2),NSIG) C-CRA REAL DC((JCAP+1)*(JCAP+2),NSIG) C-CRA REAL TC((JCAP+1)*(JCAP+2),NSIG) C-CRA REAL QC((JCAP+1)*(JCAP+2),NSIG) C-CRA REAL PC((JCAP+1)*(JCAP+2)) C-CRA REAL RC((JCAP+1)*(JCAP+2)) C-CRA REAL PLN((JCAP+1)*(JCAP+2),NLATH) C-CRA REAL QLN((JCAP+1)*(JCAP+2),NLATH) C-CRA REAL RLN((JCAP+1)*(JCAP+2),NLATH) C-CRA REAL DELPS((JCAP+1)*(JCAP+2)) C-CRA INTEGER IDATEG(4) C-CRA CHARACTER*4 ON85(8) DIMENSION GU(2*48+1,192+2,28) DIMENSION GV(2*48+1,192+2,28) DIMENSION GT(2*48+1,192+2,28) DIMENSION GP(2*48+1,192+2) DIMENSION PLONB(2*48+1,192+2) DIMENSION PLATB(2*48+1,192+2) DIMENSION GQ(2*48+1,192+2,28) DIMENSION VORTB(2*48+1,192+2,28) DIMENSION DIVB(2*48+1,192+2,28) DIMENSION GMTNS(2*48+1,192+2) DIMENSION SIGL(28),SIGI(28+1) DIMENSION DEL2((62+1)*(62+2)) DIMENSION TRIGS(192*2),IFAX(10) DIMENSION ML2LM((62+1)*(62+2)) DIMENSION FACTSLM((62+1)*(62+2)) DIMENSION FACTVLM((62+1)*(62+2)) REAL ZC((62+1)*(62+2),28) REAL DC((62+1)*(62+2),28) REAL TC((62+1)*(62+2),28) REAL QC((62+1)*(62+2),28) REAL PC((62+1)*(62+2)) REAL RC((62+1)*(62+2)) REAL PLN((62+1)*(62+2),48) REAL QLN((62+1)*(62+2),48) REAL RLN((62+1)*(62+2),48) REAL DELPS((62+1)*(62+2)) INTEGER IDATEG(4) CHARACTER*4 ON85(8) C-------- C-------- LOCAL SPACE C-------- C-------- C-------- READ IN GUESS, PUTTING INTO INTERNAL FORMAT. C-------- CALL RDGESC(ZC,DC,TC,QC,PC,RC,HOURG,IDATEG,SIGI,SIGL, * INGES,JCAP,NSIG,ON85,ML2LM,FACTSLM,FACTVLM) C-------- C-------- RECONSTRUCT VARIABLES ON GRID C-------- C-------NEED DEL**2(PS) FOR GETTING GRAD(LN(PSFC)) C----------------- DO KK=1,NSIG*3+3 IF(KK.EQ.NSIG*3+1) THEN C-CRA DELPS=-DEL2*PC C REAL DELPS((JCAP+1)*(JCAP+2)) DO ITMP=1,(JCAP+1)*(JCAP+2) DELPS(ITMP)=-DEL2(ITMP)*PC(ITMP) ENDDO CALL S2GRAD(DELPS,PLONB,PLATB,JCAP,NLON,NLATH, * QLN,RLN,TRIGS,IFAX) END IF IF(KK.EQ.NSIG*3+2) * CALL S2G0(PC,GP,JCAP,NLON,NLATH,PLN,TRIGS,IFAX) IF(KK.EQ.NSIG*3+3) * CALL S2G0(RC,GMTNS,JCAP,NLON,NLATH,PLN,TRIGS,IFAX) K=MOD(KK-1,NSIG)+1 IF(KK.GE.1.AND.KK.LE.NSIG) THEN CALL S2G0(ZC(1,K),VORTB(1,1,K),JCAP,NLON,NLATH,PLN, * TRIGS,IFAX) CALL S2G0(DC(1,K),DIVB(1,1,K),JCAP,NLON,NLATH,PLN, * TRIGS,IFAX) CALL S2GVEC(ZC(1,K),DC(1,K),GU(1,1,K),GV(1,1,K), * JCAP,NLON,NLATH,QLN,RLN,TRIGS,IFAX) END IF IF(KK.GE.NSIG+1.AND.KK.LE.2*NSIG) THEN CALL S2G0(TC(1,K),GT(1,1,K),JCAP,NLON,NLATH,PLN, * TRIGS,IFAX) ENDIF IF(KK.GE.2*NSIG+1.AND.KK.LE.3*NSIG) * CALL S2G0(QC(1,K),GQ(1,1,K),JCAP,NLON,NLATH,PLN, * TRIGS,IFAX) END DO RETURN END