SUBROUTINE GWATER(FILTA,DT,IFILT,SATCRI,ACUMT,RELKUO,NUN,NKUO) COMMON IDATE(4), * GESHEM( 50 , 42 ),TSEA( 50 , 42 ),GRGRID( 50 , 42 ) COMMON DPDPHI( 306 ),DPDLAM( 289 ),RELVOR( 7 ),ABSVOR( 7 ), 1 Q( 289 ), TE( 289 , 7 ), DI( 289 , 7 ), ZE( 289 , 7 ), 2 Z( 289 ), Y( 289 , 7 ), X( 289 , 7 ), W( 289 , 7 ), 3 QM( 289 ),TEM( 289 , 7 ),DIM( 289 , 7 ),ZEM( 289 , 7 ), 5 GZ( 289 ), RQ( 289 , 6 ), RM( 289 , 6 ), RT( 289 , 6 ) COMPLEX GZ,Q,TE,DI,ZE,Z,Y,X,W,QM,TEM,DIM,ZEM,RELVOR, 1DPDLAM,DPDPHI,ABSVOR,RQ,RM,RT COMMON * PS( 50 ), DPHI( 50 ), DLAM( 50 ), * QF( 50 ),DPHIF( 50 ),DLAMF( 50 ), * EF( 50 , 7 ), EEF( 50 , 7 ), CG( 50 , 7 ), * TF( 50 , 7 ), TEF( 50 , 7 ),TAU( 50 , 7 ), * AF( 50 , 7 ), ZEF( 50 , 7 ), A( 50 , 7 ), * BF( 50 , 7 ), DIF( 50 , 7 ), B( 50 , 7 ), * FF( 50 , 7 ), UF( 50 , 7 ), F( 50 , 7 ), * GF( 50 , 7 ), VF( 50 , 7 ), G( 50 , 7 ), * UQF( 50 , 6 ), UQFF( 50 , 6 ), * VQF( 50 , 6 ), VQFF( 50 , 6 ), * RQF( 50 , 6 ), RQFF( 50 , 6 ), RTG( 50 , 6 ) COMMON * U1( 50 ),V1( 50 ),T1( 50 ),Q1( 50 ), * U2( 50 ),V2( 50 ),T2( 50 ),Q2( 50 ) COMMON/PLNCOM/PLN( 306 ),DER( 289 ),PLNWCS( 289 ),EPS( 306 ), 1 COLRAD( 21 ),WGT( 21 ),WGTCS( 21 ),RCS2( 21 ) DOUBLE PRECISION COLRAD,EPS COMMON/VERCOM/AM( 7 , 7 ),HM( 7 , 7 ),TM( 7 , 7 ), O BM( 7 , 7 ),CM( 7 , 7 ),EKIN( 7 ), 1 SI( 8 ),SL( 7 ),DEL( 7 ),RDEL2( 7 ),RMSDOT( 6 ), 2 CI( 8 ),CL( 7 ),TOV( 7 ), SV( 7 ), RPI( 6 ), 3 P1( 7 ),P2( 7 ), H1( 7 ), H2( 7 ),RPIREC( 6 ), 4 ROTSIN,ROTCOS,SEADRY,SL1KAP,C1,C2,RLRV,SL100K C ----------------------MEMBER GCOM--------------------------------- C RT CONTAINS SPECTRAL Q TENDENCIES FROM DYNAMICS COMPUTED IN C NSLOOP AND WALLFD. SEA SURF EVAPORATION SHOULD BE IN WALLFD C*** DT2=DT+DT NUN=0 NKUO=0 MSTA=0 C*** C FIRST,STEP Q IN TIME TO OBTAIN PRELIM. FORECAST. PUT IN X DO 49 K=1, 6 DO 49 I=1, 289 X(I,K)=CMPLX(REAL(RM(I,K))+DT2* REAL(RT(I,K)) , 1 AIMAG(RM(I,K))+DT2*AIMAG(RT(I,K)) ) 49 CONTINUE C RT WILL CONTAIN ADJUESTED Q AT END OF LAT LOOP C RT WAS USED IN X=ESTIMATED NEW Q C ZERO ADJUSTED TEMP. COEFS. CJPB CALL XSTORE(RT(1,1),0.,2* 289 * 6 ) CALL YSTORE(RT(1,1),(0.,0.), 289 * 6 ) CJPB CALL XSTORE( Y(1,1),0.,2* 289 * 7 ) CALL YSTORE( Y(1,1),(0.,0.), 289 * 7 ) C DO 1000 LAT=1, 21 CALL PLN2 (PLN, COLRAD, LAT, EPS) DO 10 K=1, 7 CALL SUMPLS (TE(1,K), CG(1,K), UF(1,K), PLN) 10 CONTINUE CALL SUMPLS (Q, PS, QF, PLN) DO 11 K=1, 6 CALL SUMPLS(RQ(1,K),A(1,K),AF(1,K),PLN) C A(I,K) CONTAIN Q AT N CALL SUMPLS( X(1,K),RTG(1,K), EEF(1,K),PLN ) 11 CONTINUE LATCO=LAT CALL FFS99( CG,G, 7 ) CALL FFS99(RTG,G, 6 ) CALL FFS99( A,G, 6 ) CALL FFS99( PS,G,1) DO 2 I=1, 50 2 PS(I)=EXP(PS(I)) CALL CONKUO(DT,SATCRI,ACUMT,NKUO,PS,DEL,SL,A,RTG,CG,B,F, 1 GESHEM(1,LATCO),RELKUO,MSTA) C CALL LRGSCL(SATCRI,GESHEM(1,LATCO),CG,G,RTG,PS,B,DEL, 1 DLAM,SL,DLAMF,DPHIF,F) C CALL FIXTET(PS,DLAM,DEL,RPI,RPIREC,CG,RTG,TAU,NUN,SL100K) CALL FFA99( CG, TF,G, 7 ) CALL FFA99(RTG,RQF,G, 6 ) LATCO= 42 +1-LAT CALL FFS99( UF,G, 7 ) CALL FFS99(EEF,G, 6 ) CALL FFS99( AF,G, 6 ) CALL FFS99( QF,G,1) DO 3 I=1, 50 3 QF(I)=EXP(QF(I)) CALL CONKUO(DT,SATCRI,ACUMT,NKUO,QF,DEL,SL,AF,EEF,UF,B,F, 1 GESHEM(1,LATCO),RELKUO,MSTA) C CALL LRGSCL(SATCRI,GESHEM(1,LATCO),UF,G,EEF,QF,B,DEL, 1 DLAM,SL,DLAMF,DPHIF,F) C CALL FIXTET(QF,DLAM,DEL,RPI,RPIREC,UF,EEF,TAU,NUN,SL100K) C CALL FFA99( UF, TEF,G, 7 ) CALL FFA99(EEF,RQFF,G, 6 ) DO 90 I=1, 306 PLN(I)=PLN(I)*WGT(LAT) 90 CONTINUE DO 16 K=1, 7 CALL SYMASY (TF(1,K), TEF(1,K)) CALL FL22 (TF(1,K), TEF(1,K), Y(1,K), PLN) 16 CONTINUE DO 17 K=1, 6 CALL SYMASY(RQF(1,K),RQFF(1,K)) CALL FL22(RQF(1,K),RQFF(1,K),RT(1,K),PLN) 17 CONTINUE C RAITOT=RAITOT+WGT(LAT)*RAILAT/(2.* 50 .* 9.8 ) 1000 CONTINUE C*** MOVE CORRECTED TEMP. INTO TE. COMPLETE TIME FILTER IN MAIN DO 70 K=1, 7 DO 70 I=1, 289 TE(I,K) = Y(I,K) 70 CONTINUE C RT NOW CONTAINS ADJUSTED PREDICTED Q. NEXT TIME FILTER IF(IFILT.EQ.0) GO TO 750 FILTB=(1.-FILTA)*0.5 DO 75 K=1, 6 DO 75 I=1, 289 RM(I,K)=CMPLX( 1FILTA* REAL(RQ(I,K))+FILTB*( REAL(RT(I,K))+ REAL(RM(I,K))) , 2FILTA*AIMAG(RQ(I,K))+FILTB*(AIMAG(RT(I,K))+AIMAG(RM(I,K))) ) 75 CONTINUE 750 CONTINUE DO 76 K=1, 6 DO 76 I=1, 289 RQ(I,K)=RT(I,K) 76 CONTINUE C(DEBUGLINE) VERSION CREATED JULY 8 1982 BY J.SELA,NMC. RETURN END