SUBROUTINE GTBHALF(INEOFS,BHALF,BHALFP,JCAP,NSIG,NLATH,A, * JCAPSTAT,NSIGSTAT,AGVZ,WGVZ,BVZ,NMDSZH,VZ,VD,VH,VQ,SIGL) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: GETBHALF OBTAIN BHALF AND VERT. FUNCTS. C PRGMMR: PARRISH ORG: W/NMC22 DATE: 90-10-06 C C ABSTRACT: OBTAIN BHALF, (SQRT(BHAT)) AND VERTICAL FUNCTIONS C C PROGRAM HISTORY LOG: C 90-10-06 PARRISH C C INPUT ARGUMENT LIST: C INEOFS - INPUT FILE FOR INPUT STATISTICS C JCAP - TRIANGULAR TRUNCATION C NSIG - NUMBER OF SIGMA LEVELS C NLATH - NUMBER OF GAUSSIAN LATS IN ONE HEMISPHERE C A - A(4): SCALING FACTORS FOR FORECAST ERROR SPECTRA C JCAPSTAT - TRIANGULAR TRUNCATION FOR STATISTICS C NSIGSTAT - NUMBER OF SIGMA LEVELS FOR STATISTICS C NMDSZH - NUMBER OF VERTICAL MODES USED IN BALANCE STATS C SIGL - SIGMA LAYER VALUES FOR MODEL C C OUTPUT ARGUMENT LIST: C BHALF - SQRT(BHAT) WHERE BHAT IS BACKGROUND ERROR SPECTRUM C BHALFP - SQRT(BHATP) WHERE BHAT IS SUR. PRESS. BACK.ERROR SPECTRUM C AGVZ,WGVZ,BVZ - ARRAYS TO CONVERT MASS VARIABLE TO T,LN(PS),DIV C VZ,VD,VH,VQ - VERTICAL FUNCTIONS FOR VORT,DIV, TEMP, AND SPEC HUM C C ATTRIBUTES: C LANGUAGE: CFT77 C MACHINE: CRAY YMP C C$$$ C-CRA DIMENSION SIGL(NSIG) C-CRA DIMENSION AIBW(NSIG,NSIG),W(NSIG),VZ(NSIG,NSIG) C-CRA DIMENSION VD(NSIG,NSIG),VH(NSIG,NSIG),VQ(NSIG,NSIG) C-CRA DIMENSION CHALF(0:JCAPSTAT,0:JCAPSTAT,NSIG,4) C-CRA DIMENSION CHALFP(0:JCAPSTAT,0:JCAPSTAT) C-CRA DIMENSION BHALF((JCAP+1)*(JCAP+2),NSIG,4),A(4) C-CRA DIMENSION BHALFP((JCAP+1)*(JCAP+2)) C-CRA DIMENSION BETA(0:JCAP,NSIG),GAMMA(0:JCAP,NSIG) C-CRA DIMENSION GAMMAC(0:JCAPSTAT,NSIG) C-CRA DIMENSION GAMMAP(0:JCAP),GAMMAPC(0:JCAPSTAT) C-CRA DIMENSION BETAC(0:JCAPSTAT,NSIG) C-CRA DIMENSION RLSG(NSIG),TBAR(NSIG),A3(NSIG,NSIG) C-CRA DIMENSION AINV(NSIG,NSIG) C-CRA DIMENSION ALPHAR(NSIG),LWORK(NSIG),MWORK(NSIG) C-CRA DIMENSION AGVZ(0:JCAP,NSIG,NMDSZH),WGVZ(0:JCAP,NMDSZH) C-CRA DIMENSION BVZ(0:JCAP,NSIG,NMDSZH) DIMENSION SIGL(28) DIMENSION AIBW(28,28),W(28),VZ(28,28) DIMENSION VD(28,28),VH(28,28),VQ(28,28) DIMENSION CHALF(0:126,0:126,28,4) DIMENSION CHALFP(0:126,0:126) DIMENSION BHALF((62+1)*(62+2),28,4),A(4) DIMENSION BHALFP((62+1)*(62+2)) DIMENSION BETA(0:62,28),GAMMA(0:62,28) DIMENSION GAMMAC(0:126,28) DIMENSION GAMMAP(0:62),GAMMAPC(0:126) DIMENSION BETAC(0:126,28) DIMENSION RLSG(28),TBAR(28),A3(28,28) DIMENSION AINV(28,28) DIMENSION ALPHAR(28),LWORK(28),MWORK(28) DIMENSION AGVZ(0:62,28,28),WGVZ(0:62,28) DIMENSION BVZ(0:62,28,28) C-------- PRINT *,' READ IN VERT EOFS AND HORIZ ERROR SPECTRA ', * 'FROM UNIT ',INEOFS IF(NSIG.NE.NSIGSTAT) THEN PRINT *,' NEW VERTICAL RESOLUTION, INTERPOLATE EOFS' PRINT *,' STOPPING CODE ' END IF REWIND INEOFS READ(INEOFS)MSIG,MLATH,MMDSZH,KCAP,RLSG,AIBW,W, * ROGC,TBAR,A3,VZ,VD,VH,VQ,CHALF,CHALFP C THIS PLACE PASSED READ(INEOFS)BETAC,GAMMAC,GAMMAPC REWIND INEOFS PRINT *,' FOR VERT EOFS, NSIG=',MSIG, * ', NMDSZH=',MMDSZH,', JCAP=',KCAP,', NLATH=',MLATH C THIS PLACE PASSED C-CRA BETA=0. C DIMENSION BETA(0:62,28),GAMMA(0:62,28) DO J=1,NSIG DO I=0,JCAP BETA(I,J)=0. ENDDO ENDDO DO 190 K=1,NSIG DO 190 N=0,MIN(JCAP,JCAPSTAT) BETA(N,K)=BETAC(N,K) 190 CONTINUE C-------- C-------- NOW TAKE CARE OF HORIZONTAL PART OF STATS C-------- C-CRA GAMMA=0 C DIMENSION BETA(0:62,28),GAMMA(0:62,28) DO J=1,NSIG DO I=0,JCAP GAMMA(I,J)=0 ENDDO ENDDO C THIS PALCE PASSED DO 200 M=1,NSIG DO 200 N=0,MIN(JCAP,JCAPSTAT) GAMMA(N,M)=GAMMAC(N,M) 200 CONTINUE DO N=0,MIN(JCAP,JCAPSTAT) GAMMAP(N)=GAMMAPC(N) END DO C-CRA BHALF=0. C DIMENSION BHALF((62+1)*(62+2),28,4),A(4) DO I=1,(JCAP+1)*(JCAP+2)*NSIG*4 BHALF(I,1,1)=0. ENDDO DO LL=1,4 DO K=1,NSIG II=-1 DO M=0,MIN(JCAP,JCAPSTAT) DO L=0,MIN(JCAP,JCAPSTAT)-M II=II+2 BHALF(II,K,LL)=CHALF(M,L,K,LL) BHALF(II+1,K,LL)=BHALF(II,K,LL) END DO END DO END DO END DO C-CRA BHALFP=0. C DIMENSION BHALFP((62+1)*(62+2)) DO I=1,(JCAP+1)*(JCAP+2) BHALFP(I)=0. ENDDO II=-1 DO M=0,MIN(JCAP,JCAPSTAT) DO L=0,MIN(JCAP,JCAPSTAT)-M II=II+2 BHALFP(II)=CHALFP(M,L) BHALFP(II+1)=BHALFP(II) END DO END DO DO 300 L=1,4 DO 300 I=1,(JCAP+1)*(JCAP+2)*NSIG IF(BHALF(I,1,L) .LT. 0.)THEN PRINT *,' WARNING ' PRINT *,I,L,BHALF(I,1,L) END IF BHALF(I,1,L)=A(L)*BHALF(I,1,L) 300 CONTINUE DO I=1,(JCAP+1)*(JCAP+2) IF(BHALFP(I) .LT. 0.)THEN PRINT *,' WARNING SURFACE' PRINT *,I,BHALFP(I) END IF BHALFP(I)=A(3)*BHALFP(I) END DO DO 400 K=1,NSIG BHALF(1,K,1)=0. BHALF(1,K,2)=0. 400 CONTINUE DO 500 I=1,NSIG*4*(JCAP+1)*(JCAP+2) BHALF(I,1,1)=SQRT(BHALF(I,1,1)) 500 CONTINUE C-CRA BHALFP=SQRT(BHALFP) C DIMENSION BHALFP((62+1)*(62+2)) DO I=1,(JCAP+1)*(JCAP+2) BHALFP(I)=SQRT(BHALFP(I)) ENDDO CLOSE(INEOFS) C------------------- C-CRA AGVZ=0. C DIMENSION AGVZ(0:62,28,28),WGVZ(0:62,28) DO K=1,NMDSZH DO J=1,NSIG DO I=0,JCAP AGVZ(I,J,K)=0. ENDDO ENDDO ENDDO C-CRA WGVZ=0. DO K=1,NMDSZH DO I=0,JCAP WGVZ(I,K)=0. ENDDO ENDDO C-CRA BVZ=0. C DIMENSION BVZ(0:62,28,28) DO K=1,NMDSZH DO J=1,NSIG DO I=0,JCAP BVZ(I,J,K)=0. ENDDO ENDDO ENDDO DO J=1,NSIG DO K=1,NSIG C-CRA IF(J.LE.NMDSZH) C-CRA * WGVZ(1:JCAP,J)=WGVZ(1:JCAP,J) C-CRA * +W(K)*GAMMAP(1:JCAP)*VZ(K,J) IF(J.LE.NMDSZH) THEN DO I=1,JCAP WGVZ(I,J)=WGVZ(I,J)+W(K)*GAMMAP(I)*VZ(K,J) ENDDO ENDIF DO I=1,NSIG C-CRA IF(K.LE.NMDSZH) C-CRA * AGVZ(1:JCAP,J,K)=AGVZ(1:JCAP,J,K) C-CRA * +AIBW(J,I)*GAMMA(1:JCAP,J)*VZ(I,K) IF(K.LE.NMDSZH) THEN DO L=1,JCAP AGVZ(L,J,K)=AGVZ(L,J,K)+AIBW(J,I)*GAMMA(L,J)*VZ(I,K) ENDDO ENDIF END DO C-CRA IF(K.LE.NMDSZH) C-CRA * BVZ(1:JCAP,J,K)=BETA(1:JCAP,J)*VZ(J,K) IF(K.LE.NMDSZH) THEN DO I=1,JCAP BVZ(I,J,K)=BETA(I,J)*VZ(J,K) ENDDO ENDIF END DO END DO RETURN END