SUBROUTINE SETUPRHS(SIGL,JITER,RPW,SIGI, * INGES,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$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: SETUPRHS COMPUTE RHS OF OI EQUATION C PRGMMR: PARRISH ORG: W/NMC22 DATE: 90-10-06 C C ABSTRACT: READ IN DATA, FIRST GUESS, AND OBTAIN RHS OF OI EQUATION. C C PROGRAM HISTORY LOG: C 90-10-06 PARRISH C C INPUT ARGUMENT LIST: C JITER - OUTER ITERATION COUNTER 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 PWCON - CONSTANTS USED FOR INTEGRATION OF PRECIP. WATER C NTDATA,NSDATA,NWDATA,NPDATA,NQDATA,NPWDAT - NUM T, SATT, ETC OBS C ISAT - UNIT NUMBER OF INPUT VERT. SAT. STATS C NSIGSAT - NUMBER OF SIGMA LEVELS FOR INPUT VERT SAT. STATS C JSAT - UNIT NUMBER OF OUTPUT SAT. INFOR. C ISFC - UNIT NUMBER BGES FILE C ISATV - VERTICAL ARRAY TO INDICATE HORIZONTAL ERROR COV. USED. C ISCRA - UNIT NUMBER OF OUTPUT CONVENTIONAL OBSERVATION INFOR. C NBLK - BLOCKING FACTOR FOR OUTPUT FILES C RT,RU,RV,RQ,RP,RPW - SCRATCH GRID ARRAYS C A3 - HYDROSTATIC MATRIX C AMPDIVT,DAMPDIVT - PARAMETERS FOR DIV-TEND PENALTY C ERMAXT,ERMAXW,ERMAXP,ERMAXQ,ERMAXPW - PARAMETERS FOR C ERMINT,ERMINW,ERMINP,ERMINQ,ERMINPW - GROSS ERROR C GROSST,GROSSST,GROSSW,GROSSP,GROSSQ,GROSSPW - CHECK OF DATA C C OUTPUT ARGUMENT LIST: C SIGL,SIGI - SIGMA LAYER MIDPOINT AND INTERFACE VALUES C NTRECS,NWRECS,NPRECS,NQRECS,NPWRECS - NUM T, SATT, ETC RECORDS C MSAT - NUMBER OF SATELLITE RECORDS C RLATS - GRID LATITUDES (RADIANS) C AP,BP,AQR,BQR,GR - RECURSION CONSTANTS FOR SPHERICAL HARMONICS C DEL2 - N*(N+1)/(A**2) C SLAT,CLAT - SIN AND COS OF GAUSSIAN LATITUDES C PE0,QE0,RO0 - STARTING FUNCTIONS FOR SPHERICAL HARMONICS C WGTS - GAUSSIAN INTEGRATION WEIGHTS C TRIGS,IFAX - USED BY FFT C LMIX,LASTMIX,LPAIRS - USED FOR MULTITASKING C IN - 2-DIM WAVE-NUMBER VALUE OF EACH COEF C DSTLAST,DSTB - COEFS OF LAST AND GUESS DIV-TEND C C ATTRIBUTES: C LANGUAGE: CFT77 C MACHINE: CRAY YMP C C$$$ C C-CRA DIMENSION TRIGS(NLON*2),IFAX(10),RLATS(NLATH*2) 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 IN((JCAP+1)*(JCAP+2)) C-CRA DIMENSION DSTLAST((JCAP+1)*(JCAP+2),NSIG) C-CRA DIMENSION DSTB((JCAP+1)*(JCAP+2),NSIG) 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 RTS(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION RUS(2*NLATH+1,NLON+2,NSIG) C-CRA DIMENSION RVS(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 RLONS(NLON) C-CRA DIMENSION TDATA(NTDATA,8),WDATA(NWDATA,8) C-CRA DIMENSION SDATA(NSDATA,6) C-CRA DIMENSION PSDATA(NPDATA,8),QDATA(NQDATA,7) C-CRA DIMENSION PWDATA(NPWDAT,6) C-CRA DIMENSION RPW(2*NLATH+1,NLON+2) C-CRA DIMENSION SIGI(NSIG+1) C-CRA DIMENSION TEMPT(NTDATA),TEMPS(NSDATA),TEMPQ(NQDATA) C-CRA DIMENSION TEMPP(NPDATA),TEMPPW(NPWDAT),TEMPW(NWDATA) C-CRA DIMENSION TPRES(NTDATA),QPRES(NQDATA),WPRES(NWDATA) C-CRA DIMENSION SPRES(NSDATA) C-CRA DIMENSION TGES(NTDATA),QGES(NQDATA),VGES(NWDATA),SGES(NSDATA) C-CRA DIMENSION PGES(NPDATA),UGES(NWDATA),PWGES(NPWDAT) C-CRA DIMENSION RQTYPE(NQDATA),RWTYPE(NWDATA),QTGES(NTDATA) C-CRA DIMENSION IQTFLG(NTDATA) C-CRA DIMENSION PTYPE(NPDATA),PWTYPE(NPWDAT) C-CRA DIMENSION QMAXERR(NQDATA),PWMERR(NPWDAT) C-CRA DIMENSION FACT(NWDATA) C-CRA DIMENSION RBQS(NQDATA) C-CRA DIMENSION FACTOR(2*NLATH+1,NLON+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) C-CRA REAL DEL2((JCAP+1)*(JCAP+2)) C-CRA REAL PWCON(NSIG) C-CRA REAL WGTS(NLATH*2),SIGL(NSIG) C-CRA INTEGER IDATEG(4) C-CRA INTEGER IDATEG2(4),IDATE5(5) DIMENSION TRIGS(192*2),IFAX(10),RLATS(48*2) 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 IN((62+1)*(62+2)) DIMENSION DSTLAST((62+1)*(62+2),28) DIMENSION DSTB((62+1)*(62+2),28) 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 RTS(2*48+1,192+2,28) DIMENSION RUS(2*48+1,192+2,28) DIMENSION RVS(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 RLONS(192) DIMENSION TDATA(60000,8),WDATA(85000,8) DIMENSION SDATA(120000,6) DIMENSION PSDATA(18000,8),QDATA(15000,7) DIMENSION PWDATA(1,6) DIMENSION RPW(2*48+1,192+2) DIMENSION SIGI(28+1) DIMENSION TEMPT(60000),TEMPS(120000),TEMPQ(15000) DIMENSION TEMPP(18000),TEMPPW(1),TEMPW(85000) DIMENSION TPRES(60000),QPRES(15000),WPRES(85000) DIMENSION SPRES(120000) DIMENSION TGES(60000),QGES(15000) DIMENSION VGES(85000),SGES(120000) DIMENSION PGES(18000),UGES(85000),PWGES(1) DIMENSION RQTYPE(15000),RWTYPE(85000),QTGES(60000) DIMENSION IQTFLG(60000) DIMENSION PTYPE(18000),PWTYPE(1) DIMENSION QMAXERR(15000),PWMERR(1) DIMENSION FACT(85000) DIMENSION RBQS(15000) DIMENSION FACTOR(2*48+1,192+2) DIMENSION QFILE(17*15000),UVFILE(18*85000) DIMENSION TFILE(17*60000) DIMENSION SFILE((4+(28+2)*30)*10000),PWFILE(12*1) DIMENSION PSFILE(11*18000) REAL DEL2((62+1)*(62+2)) REAL PWCON(28) REAL WGTS(48*2),SIGL(28) INTEGER IDATEG(4) INTEGER IDATEG2(4),IDATE5(5) C-------- C-------- SCRATCH SPACE C-------- C--------------- C-CRA ISATV=1 C DIMENSION ISATV(NSIG) DO ITMP=1,NSIG ISATV(ITMP)=1 ENDDO C----------------PRESET NUMBER OF DATA RECORDS TO ZERO NTRECS=0 NWRECS=0 NPRECS=0 NQRECS=0 NPWRECS=0 C-------- C-------- INITIALIZE VARIOUS TRANSFORM CONSTANTS C-------- CALL GETLALO(RLATS,RLONS,WGTS,JCAP,NLON,NLATH, * DEL2,TRIGS,IFAX,PLN,QLN,RLN) C-------- C-------- 1. READ DATA C-------- CALL RDPREP( * TDATA,SDATA,WDATA,PSDATA,QDATA,PWDATA, * TDATA(1,8),SDATA(1,6),RWTYPE,PTYPE,RQTYPE,PWTYPE, * QMAXERR,PWMERR,IQTFLG, * NTDATA,NSDATA,NWDATA,NPDATA,NQDATA,NPWDAT) WRITE(6,*) 'PORTION OF PSDATA' DO N=1,50 WRITE(6,'(8F10.2)') (PSDATA(N,I),I=1,8) ENDDO C-------- C-------- 2. CHECK FOR CONSISTENCY OF TIMES FOR PREVIOUS ANALYSIS C-------- AND 6 HR FORECAST, BRING IN 6 HR FORECAST ON GRID. C-------- DELTAT=-9999 REWIND INGES READ(INGES) READ(INGES)HOURG,IDATEG IDATE5(1)=IDATEG(4) IDATE5(2)=IDATEG(2) IDATE5(3)=IDATEG(3) IDATE5(4)=IDATEG(1) IDATE5(5)=0 CALL W3FS21(IDATE5,NMING) NMING=NMING+60*HOURG WRITE(6,*) ' GUESS FILE ',HOURG,IDATEG WRITE(6,*)' FOR GUESS FILE, NMING=',NMING CLOSE(INGES) REWIND IIANL READ(IIANL,END=1112) READ(IIANL,END=1112)HOURG2,IDATEG2 IDATE5(1)=IDATEG2(4) IDATE5(2)=IDATEG2(2) IDATE5(3)=IDATEG2(3) IDATE5(4)=IDATEG2(1) IDATE5(5)=0 CALL W3FS21(IDATE5,NMING2) NMING2=NMING2+60*HOURG2 WRITE(6,*) ' ANALYSIS FILE ',HOURG2,IDATEG2 WRITE(6,*) ' FOR ANALYSIS FILE, NMING2=',NMING2 CLOSE(IIANL) IF(ABS(HOURG2) .GT. .001 .OR. ABS(HOURG) * .GT. 6.001 )GO TO 1112 DELTATT=(NMING-NMING2)/60. IF(ABS(DELTATT-6.).GT..01) GO TO 1112 DELTAT=6. C-------- 1112 CONTINUE CALL INGUESSV(RU,RV,RT,RP,RQ,RPW,SIGI,SIGL, * INGES,JCAP,NSIG,NLATH,NLON,HOURG,IDATEG, * RVORTS,RUS,RPLONS,RPLATS,DEL2,PLN,QLN,RLN,TRIGS,IFAX, * ML2LM,FACTSLM,FACTVLM) WRITE(6,*)' DELTAT = ',DELTAT C CALL MAXMIN(RU(1,1,1),(2*48+1),(192+2), 1 (2*48+1),192,'U ') CALL MAXMIN(RV(1,1,1),(2*48+1),(192+2), 1 (2*48+1),192,'V ') CALL MAXMIN(RT(1,1,1),(2*48+1),(192+2), 1 (2*48+1),192,'T ') CALL MAXMIN(RP(1,1 ),(2*48+1),(192+2), 1 (2*48+1),192,'LN(PS) ') CALL MAXMIN(RVORTS(1,1,1),(2*48+1),(192+2), 1 (2*48+1),192,'VORT ') CALL MAXMIN(RUS(1,1,1),(2*48+1),(192+2), 1 (2*48+1),192,'DIV ') CALL MAXMIN(RPLONS(1,1 ),(2*48+1),(192+2), 1 (2*48+1),192,'DPDLON ') CALL MAXMIN(RPLATS(1,1 ),(2*48+1),(192+2), 1 (2*48+1),192,'DPDLAT ') CALL MAXMIN(RPW(1,1 ),(2*48+1),(192+2), 1 (2*48+1),192,'Z0 ') C C-------- C-------- PREPROCESS DATA, I.E, CONVERT TO GRID LOCATIONS, MODIFY ERROR C-------- ETC. C-------- ANSIG=FLOAT(NSIG) C C READ SURFACE FILE TO GET 10M WIND FACTORS REWIND(ISFC) CALL RDFACT(FACTOR,IDATEG,HOURG,NLATH,NLON,ISFC) C C SET BEGINNING AND ENDING LATS FOR INCREASING WEIGHT IN S.H. C BLAT=10.*0.017453292 ELAT=20.*0.017453292 CALL GDCRDP(BLAT,1,RLATS,2*NLATH) CALL GDCRDP(ELAT,1,RLATS,2*NLATH) C-----------------RUS HAS LATEST DIV C PRINT *,' BEFORE NEW FULLDIVT, ',RU(1,1,1),RV(1,1,1),RT(1,1,1), C * RP(1,1),RQ(1,1,1),RPW(1,1),RVORTS(1,1,1),RUS(1,1,1), C * RPLONS(1,1),RPLATS(1,1) C CALL FULLDIVT(RU,RV,RT,RVORTS,RUS,RPLONS,RPLATS,RPW, * NSIG,JCAP,NLON,NLATH,PLN,QLN,RLN,TRIGS,IFAX,DEL2,WGTS,A3, * SIGL,SIGI,JITER,DSTLAST,RLATS) C C WRITE(6,*)' AFTER NEW FULLDIVT, ',DSTLAST(LMAD(1,1),1) C-----------------NOW RUS HAS LATEST VERT VELOCITY C-CRA RUS=RU C DIMENSION RUS(2*NLATH+1,NLON+2,NSIG) DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG RUS(ITMP,1,1)=RU(ITMP,1,1) ENDDO C-CRA RVS=RV C DIMENSION RVS(2*NLATH+1,NLON+2,NSIG) DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG RVS(ITMP,1,1)=RV(ITMP,1,1) ENDDO C-CRA RTS=RT C DIMENSION RTS(2*NLATH+1,NLON+2,NSIG) DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG RTS(ITMP,1,1)=RT(ITMP,1,1) ENDDO C REWIND ISCRA3 C WRITE(ISCRA3)RU,RPLON C WRITE(ISCRA3)RV,RPLAT C WRITE(ISCRA3)RT C WRITE(ISCRA3)RVORT C WRITE(ISCRA3)RDIV C CLOSE(ISCRA3) IF(NPDATA.GT.0) THEN CALL PREPP(PSDATA(1,1),PSDATA(1,2),PSDATA(1,3),PSDATA(1,4), * PSDATA(1,5),PSDATA(1,6),PTYPE, * NPDATA,RT,RP,RPW, * NLATH*2,NLON,NSIG,RLATS,RLONS,SIGL) IF(DELTAT .LE. 0.) THEN DO L=1,NPDATA PSDATA(L,8)=0. END DO ELSE DO L=1,NPDATA PSDATA(L,8)=MIN(MAX(-1.,PSDATA(L,8)/DELTAT),0.) END DO END IF CALL INTRP2(RP,TEMPP,PSDATA(1,3),PSDATA(1,2), * NLATH*2,NLON,NPDATA) DO L=1,NPDATA PGES(L)=(1.+PSDATA(L,8))*TEMPP(L) END DO END IF IF(NTDATA.GT.0) THEN CALL PREPT(TDATA(1,1),TDATA(1,2),TDATA(1,3),TDATA(1,4), * TDATA(1,8),TPRES,NTDATA, * RP,NLATH*2,NLON,NSIG,RLATS,RLONS,SIGL) DO I=1,NTDATA WGT1=.5 WGT2=.5 IF(I .NE. 1) THEN IF(TDATA(I,6) .EQ. TDATA(I-1,6)) THEN IF(TDATA(I,2) .EQ. TDATA(I-1,2) .AND. TDATA(I,3) .EQ. * TDATA(I-1,3) .AND. TDATA(I,8).EQ. TDATA(I-1,8)) THEN ALDIFF=TDATA(I,4)-TDATA(I-1,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT2=.5*ALDIFF IF(TDATA(I-1,4) .GE. ANSIG) THEN WGT2=0. WGT1=0. END IF END IF END IF END IF IF(I .NE. NTDATA) THEN IF(TDATA(I,6) .EQ. TDATA(I+1,6) .AND. TDATA(I,4) .LT. * ANSIG) THEN IF(TDATA(I,2) .EQ. TDATA(I+1,2) .AND. TDATA(I,3) .EQ. * TDATA(I+1,3) .AND. TDATA(I,8).EQ. TDATA(I+1,8)) THEN ALDIFF=TDATA(I+1,4)-TDATA(I,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT1=.5*ALDIFF END IF END IF END IF TDATA(I,1)=TDATA(I,1)*(WGT1+WGT2) END DO IF(DELTAT .LE. 0.) THEN DO L=1,NTDATA TDATA(L,7)=0. END DO ELSE DO L=1,NTDATA TDATA(L,7)=MIN(MAX(-1.,TDATA(L,7)/DELTAT),0.) END DO END IF CALL INTRP3(RT,TEMPT,TDATA(1,3),TDATA(1,2),TDATA(1,4), * NLATH*2,NLON,NSIG,NTDATA) DO L=1,NTDATA TGES(L)=(1.+TDATA(L,7))*TEMPT(L) END DO C-CRA QTGES=0. C DIMENSION RQTYPE(NQDATA),RWTYPE(NWDATA),QTGES(NTDATA) DO ITMP=1,NTDATA QTGES(ITMP)=0. ENDDO IF(NQTDATA .GT. 0) THEN CALL INTRP3(RQ,TEMPT,TDATA(1,3),TDATA(1,2),TDATA(1,4), * NLATH*2,NLON,NSIG,NTDATA) DO L=1,NTDATA IF(IQTFLG(L) .EQ.1) QTGES(L)=(1.+TDATA(L,7))*TEMPT(L) END DO END IF END IF IF(NSDATA.GT.0) THEN CALL PREPS(SDATA(1,1),SDATA(1,2),SDATA(1,3), * SPRES,NSDATA, * RP,NLATH*2,NLON,NSIG,RLATS,RLONS,SIGL) IF(DELTAT .LE. 0.) THEN DO L=1,NSDATA SDATA(L,5)=0. END DO ELSE DO L=1,NSDATA SDATA(L,5)=MIN(MAX(-1.,SDATA(L,5)/DELTAT),0.) END DO END IF CALL INTRP3(RT,TEMPS,SDATA(1,2),SDATA(1,1),SDATA(1,3), * NLATH*2,NLON,NSIG,NSDATA) DO L=1,NSDATA SGES(L)=(1.+SDATA(L,5))*TEMPS(L) END DO END IF IF(NPWDAT.GT.0) THEN C C CREATE CONSTANTS FOR P.W. CALCULATIONS C ACON=100./9.8 DO K=1,NSIG PWCON(K)=ACON*(SIGI(K)-SIGI(K+1)) END DO CALL PREPPW(PWDATA(1,1),PWDATA(1,2),PWDATA(1,3),PWDATA(1,4), * PWMERR,PWTYPE, * NPWDAT,NSIG,NLATH*2,NLON,RLATS,RLONS) IF(DELTAT .LE. 0.) THEN DO L=1,NPWDAT PWDATA(L,6)=0. END DO ELSE DO L=1,NPWDAT PWDATA(L,6)=MIN(MAX(-1.,PWDATA(L,6)/DELTAT),0.) END DO END IF CALL INTRP2(RP,PWDATA(1,5),PWDATA(1,3),PWDATA(1,2), * 2*NLATH,NLON,NPWDAT) DO L=1,NPWDAT PWDATA(L,5)=10.*EXP(PWDATA(L,5)) PWGES(L)=0. END DO DO K=1,NSIG CALL INTRP2(RQ(1,1,K),TEMPPW,PWDATA(1,3),PWDATA(1,2), * 2*NLATH,NLON,NPWDAT) DO L=1,NPWDAT PWGES(L)=PWGES(L)+(1.+PWDATA(L,6))*TEMPPW(L)*PWDATA(L,5)* * PWCON(K) END DO END DO END IF IF(NWDATA.GT.0) THEN C CALL PREPW(WDATA(1,1),WDATA(1,2),WDATA(1,3),WDATA(1,4), * RWTYPE,WPRES,NWDATA,RP,FACT,FACTOR, * NLATH*2,NLON,NSIG,RLATS,RLONS,SIGL) DO I=1,NWDATA WGT1=.5 WGT2=.5 IF(I .NE. 1) THEN IF(WDATA(I,7) .EQ. WDATA(I-1,7)) THEN IF(WDATA(I,2) .EQ. WDATA(I-1,2) .AND. WDATA(I,3) .EQ. * WDATA(I-1,3) .AND. RWTYPE(I) .EQ. RWTYPE(I-1)) THEN ALDIFF=WDATA(I,4)-WDATA(I-1,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT2=.5*ALDIFF IF(WDATA(I-1,4) .GE. ANSIG) THEN WGT2=0. WGT1=0. END IF END IF END IF END IF IF(I .NE. NWDATA) THEN IF(WDATA(I,7) .EQ. WDATA(I+1,7) .AND. WDATA(I,4) .LT. * ANSIG) THEN IF(WDATA(I,2) .EQ. WDATA(I+1,2) .AND. WDATA(I,3) .EQ. * WDATA(I+1,3) .AND. RWTYPE(I) .EQ. RWTYPE(I+1)) THEN ALDIFF=WDATA(I+1,4)-WDATA(I,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT1=.5*ALDIFF END IF END IF END IF WDATA(I,1)=WDATA(I,1)*(WGT1+WGT2) END DO IF(DELTAT .LE. 0.) THEN DO L=1,NWDATA WDATA(L,8)=0. END DO ELSE DO L=1,NWDATA WDATA(L,8)=MIN(MAX(-1.,WDATA(L,8)/DELTAT),0.) END DO END IF CALL INTRP3(RU,TEMPW,WDATA(1,3),WDATA(1,2),WDATA(1,4), * 2*NLATH,NLON,NSIG,NWDATA) DO L=1,NWDATA UGES(L)=(1.+WDATA(L,8))*TEMPW(L)*FACT(L) END DO CALL INTRP3(RV,TEMPW,WDATA(1,3),WDATA(1,2),WDATA(1,4), * 2*NLATH,NLON,NSIG,NWDATA) DO L=1,NWDATA VGES(L)=(1.+WDATA(L,8))*TEMPW(L)*FACT(L) END DO END IF IF(NQDATA.GT.0) THEN CALL PREPQ(QDATA(1,1),QDATA(1,2),QDATA(1,3),QDATA(1,4), * RQTYPE, * QPRES,NQDATA,QMAXERR,RBQS,RT, * RP,NLATH*2,NLON,NSIG,RLATS,RLONS,SIGL) DO I=1,NQDATA WGT1=.5 WGT2=.5 IF(I .NE. 1) THEN IF(QDATA(I,6) .EQ. QDATA(I-1,6)) THEN IF(QDATA(I,2) .EQ. QDATA(I-1,2) .AND. QDATA(I,3) .EQ. * QDATA(I-1,3) .AND. RQTYPE(I).EQ. RQTYPE(I-1)) THEN ALDIFF=QDATA(I,4)-QDATA(I-1,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT2=.5*ALDIFF IF(QDATA(I-1,4) .GE. ANSIG) THEN WGT2=0. WGT1=0. END IF END IF END IF END IF IF(I .NE. NQDATA) THEN IF(QDATA(I,6) .EQ. QDATA(I+1,6) .AND. QDATA(I,4) .LT. * ANSIG) THEN IF(QDATA(I,2) .EQ. QDATA(I+1,2) .AND. QDATA(I,3) .EQ. * QDATA(I+1,3) .AND. RQTYPE(I).EQ. RQTYPE(I+1)) THEN ALDIFF=QDATA(I+1,4)-QDATA(I,4) IF(ALDIFF .LT. 1. .AND. ALDIFF .GE. 0.) WGT1=.5*ALDIFF END IF END IF END IF QDATA(I,1)=QDATA(I,1)*(WGT1+WGT2) END DO IF(DELTAT .LE. 0.) THEN DO L=1,NQDATA QDATA(L,7)=0. END DO ELSE DO L=1,NQDATA QDATA(L,7)=MIN(MAX(-1.,QDATA(L,7)/DELTAT),0.) END DO END IF CALL INTRP3(RQ,TEMPQ,QDATA(1,3),QDATA(1,2),QDATA(1,4), * NLATH*2,NLON,NSIG,NQDATA) DO L=1,NQDATA QGES(L)=(1.+QDATA(L,7))*TEMPQ(L) END DO END IF IF(JITER.EQ.1) THEN C-CRA DSTB=DSTLAST C DIMENSION DSTB((JCAP+1)*(JCAP+2),NSIG) DO ITMP=1,(JCAP+1)*(JCAP+2)*NSIG DSTB(ITMP,1)=DSTLAST(ITMP,1) END DO ENDIF C------- C------- READ IN PREVIOUS ANALYSIS IF NECESSARY C------- IF(DELTAT .GT. 0.) THEN CALL INGUESS(RU,RV,RT,RP,RQ,RPW,SIGI,SIGL, * IIANL,JCAP,NSIG,NLATH,NLON,HOURG,IDATEG, * PLN,QLN,RLN,TRIGS,IFAX,ML2LM,FACTSLM,FACTVLM) C------- C------- ADD IN CONTIBUTIONS FROM PREVIOUS ANALYSIS TIME C------- C------- FIRST SURFACE PRESSURE C------- IF(NPDATA.GT.0) THEN CALL INTRP2(RP,TEMPP,PSDATA(1,3),PSDATA(1,2),NLATH*2, * NLON,NPDATA) DO L=1,NPDATA PGES(L)=PGES(L)-PSDATA(L,8)*TEMPP(L) END DO END IF C-------- C-------- NEXT PRECIPITABLE WATER C-------- IF(NPWDAT.GT.0) THEN C-------- C-------- OBTAIN GUESS PRECIP. WATER AT OBS LOCATIONS C-------- DO K=1,NSIG CALL INTRP2(RQ(1,1,K),TEMPPW,PWDATA(1,3),PWDATA(1,2), * 2*NLATH,NLON,NPWDAT) DO L=1,NPWDAT PWGES(L)=PWGES(L)-PWDATA(L,6)*TEMPPW(L)*PWDATA(L,5)* * PWCON(K) END DO END DO END IF C------- C-------- NEXT DO WIND RESIDUALS C-------- IF(NWDATA.GT.0) THEN CALL INTRP3(RU,TEMPW,WDATA(1,3),WDATA(1,2),WDATA(1,4), * 2*NLATH,NLON,NSIG,NWDATA) DO L=1,NWDATA UGES(L)=UGES(L)-WDATA(L,8)*TEMPW(L)*FACT(L) END DO CALL INTRP3(RV,TEMPW,WDATA(1,3),WDATA(1,2),WDATA(1,4), * 2*NLATH,NLON,NSIG,NWDATA) DO L=1,NWDATA VGES(L)=VGES(L)-WDATA(L,8)*TEMPW(L)*FACT(L) END DO END IF C-------- C-------- SATELLITE TEMPERATURE C-------- IF(NSDATA.GT.0) THEN CALL INTRP3(RT,TEMPS,SDATA(1,2),SDATA(1,1),SDATA(1,3), * NLATH*2,NLON,NSIG,NSDATA) DO L=1,NSDATA SGES(L)=SGES(L)-SDATA(L,5)*TEMPS(L) END DO END IF C-------- C-------- NOW TEMPERATURE C-------- IF(NTDATA.GT.0) THEN CALL INTRP3(RT,TEMPT,TDATA(1,3),TDATA(1,2),TDATA(1,4), * NLATH*2,NLON,NSIG,NTDATA) DO L=1,NTDATA TGES(L)=TGES(L)-TDATA(L,7)*TEMPT(L) END DO IF(NQTDATA .GT. 0) THEN CALL INTRP3(RQ,TEMPT,TDATA(1,3),TDATA(1,2),TDATA(1,4), * NLATH*2,NLON,NSIG,NTDATA) DO L=1,NTDATA IF(IQTFLG(L).EQ.1) QTGES(L)=QTGES(L)-TDATA(L,7)*TEMPT(L) END DO END IF END IF C-------- C-------- NEXT Q C-------- IF(NQDATA.GT.0) THEN CALL INTRP3(RQ,TEMPQ,QDATA(1,3),QDATA(1,2),QDATA(1,4), * NLATH*2,NLON,NSIG,NQDATA) DO L=1,NQDATA QGES(L)=QGES(L)-QDATA(L,7)*TEMPQ(L) END DO END IF END IF C C CALCULATE RESIDUALS, PUT OBSERVATION INFOR. IN FILES C AND PRINT STATISTICS C PRINT *,' BLAT,ELAT =',BLAT,ELAT IF(NPDATA.GT.0) THEN DO I=1,NPDATA PSDATA(I,4)=PSDATA(I,4)-PGES(I) END DO CALL RESPSF(PSDATA(1,4),PTYPE,NPDATA) CALL SPRP(PSDATA,PGES,PTYPE,NPDATA,NPRECS,NLATH*2,NLON, * PSFILE,ERMAXP,ERMINP,GROSSP) END IF IF(NWDATA.GT.0) THEN DO I=1,NWDATA C IF(NINT(RWTYPE(I)) .NE. 283)THEN WDATA(I,5)=WDATA(I,5)-UGES(I) WDATA(I,6)=WDATA(I,6)-VGES(I) C ELSE C SPDGES=SQRT(UGES(I)*UGES(I)+VGES(I)*VGES(I)) C SPDSSM=SQRT(WDATA(I,5)*WDATA(I,5)+WDATA(I,6)*WDATA(I,6)) C SPDN=(SPDSSM-SPDGES)/SPDGES C WDATA(I,5)=SPDSSM C WDATA(I,6)=SPDGES C END IF END DO CALL RESIDW(WDATA(1,4), * WDATA(1,5),WDATA(1,6),RWTYPE, * WPRES,NWDATA) CALL SPRUV(WDATA,UGES,VGES,FACT,RWTYPE,NWDATA,NWRECS,NLATH*2, * NLON,NSIG,UVFILE,ERMAXW,ERMINW,GROSSW) END IF MSAT=0 IF(NSDATA.GT.0) THEN DO I=1,NSDATA SDATA(I,4)=SDATA(I,4)-SGES(I) END DO CALL RESSAT(SDATA(1,3), * SDATA(1,4),SDATA(1,6),SPRES,NSDATA) DO LL=1,NSDATA IF((SDATA(LL,6) .GT. 164.5 .AND. SDATA(LL,6) .LT. 169.5) .OR. * (SDATA(LL,6) .GT. 174.5 .AND. SDATA(LL,6) .LT. 179.5)) THEN DO L=1,NSIG-4 ISATV(L)=-1 END DO GO TO 744 END IF END DO 744 CONTINUE CALL SPRS(SDATA,NSDATA,NLATH,NLON,NSIG, * MSAT,SFILE,NSIGSAT,ISAT,BLAT,ELAT,GROSSST,SIGL) END IF IF(NTDATA.GT.0) THEN IF(NQTDATA .GT. 0) THEN DO I=1,NTDATA IF(IQTFLG(I).EQ.1) THEN C PRINT *,I,TDATA(I,5),QTGES(I) TDATA(I,5)=TDATA(I,5)*(1.+.608*QTGES(I)) END IF END DO END IF DO I=1,NTDATA TDATA(I,5)=TDATA(I,5)-TGES(I) END DO CALL RESTMP(TDATA(1,4), * TDATA(1,5),TDATA(1,8),TPRES,NTDATA) CALL SPRT(TDATA,TGES,NTDATA,NTRECS,NLATH*2,NLON,NSIG, * TFILE,ERMAXT,ERMINT,GROSST) END IF IF(NPWDAT.GT.0 .OR. NQDATA .GT. 0) THEN IF(NPWDAT.GT.0) THEN DO I=1,NPWDAT PWDATA(I,4)=PWDATA(I,4)-PWGES(I) END DO CALL RESPW(PWDATA(1,1),PWDATA(1,4),PWMERR,PWTYPE,NPWDAT) END IF IF(NQDATA.GT.0) THEN DO I=1,NQDATA QDATA(I,5)=QDATA(I,5)-QGES(I) TEMPQ(I)=RBQS(I) END DO CALL RESQ(QDATA(1,1),QDATA(1,4), * QDATA(1,5),RQTYPE, * QPRES,NQDATA,QMAXERR,TEMPQ) END IF CALL SPRQPW(QDATA,QGES,RQTYPE,NQDATA,NQRECS, * PWDATA,PWGES,PWTYPE,NPWDAT,NPWRECS, * NLATH*2,NLON,NSIG, * QFILE,PWFILE,ERMAXPW,ERMINPW,GROSSPW, * ERMAXQ,ERMINQ,GROSSQ,RBQS) END IF RETURN END SUBROUTINE MAXMIN(F,IMAX,JMAX,ILIM,JLIM,CTITLE) DIMENSION F(IMAX,JMAX) CHARACTER*8 CTITLE XMAX=F(1,1) XMIN=XMAX DO J=1,JLIM DO I=1,ILIM XMAX=MAX(XMAX,F(I,J)) XMIN=MIN(XMIN,F(I,J)) ENDDO ENDDO PRINT *,CTITLE,' MAX=',XMAX,' MIN=',XMIN RETURN END SUBROUTINE NNTPRT(DATA,IMAX,JMAX,FACT) DIMENSION DATA(IMAX*JMAX) ILAST=0 I1=1 I2=80 1112 CONTINUE IF(I2.GE.IMAX) THEN ILAST=1 I2=IMAX ENDIF WRITE(6,*) ' ' DO J=1,JMAX WRITE(6,1111) (NINT(DATA(IMAX*(J-1)+I)*FACT),I=I1,I2) ENDDO IF(ILAST.EQ.1) RETURN I1=I1+80 I2=I1+79 IF(I2.GE.IMAX) THEN ILAST=1 I2=IMAX ENDIF GO TO 1112 1111 FORMAT(80I1) END