PROGRAM PRVR16 CJPB CHARACTER*4 LAB 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--------------------------------- COMMON /LAB8/LAB(8),/LAB9/KDATE(4),IFINAL CCCC LOGICAL ISOP COMMON/NMODF/NFILES DIMENSION NUM(28) DATA JDT/0/, SHOUR/0./, JCAP/ 16 /, LEVS/ 7 /, 1FILTA/ 0.92 /,DT/ 1029. /,LIMLOW/1/ DATA PERCUT/2.7502E+4/,MODS/4/,NITER/2/,DISPK/0./ CJPB OPEN(5,FILE='PFDATA',STATUS='OLD') OPEN(6,FILE='PFOUT',STATUS='NEW') OPEN(16,FILE='DRAGSST',STATUS='OLD',FORM='UNFORMATTED') READ(5,1)IOPEN 1 FORMAT(I2) IF(IOPEN.EQ.1)THEN OPEN(18,FILE='SIG00A',STATUS='OLD',FORM='UNFORMATTED') OPEN(19,FILE='SIG00B',STATUS='NEW',RECL=578,FORM='UNFORMATTED') OPEN(20,FILE='SIG12A',STATUS='NEW',RECL=578,FORM='UNFORMATTED') OPEN(21,FILE='SIG12B',STATUS='NEW',RECL=2100,FORM='UNFORMATTED') OPEN(80,FILE='NORMOD',STATUS='OLD',FORM='UNFORMATTED') ELSE OPEN(20,FILE='SIG12A',STATUS='OLD',FORM='UNFORMATTED') OPEN(21,FILE='SIG12B',STATUS='OLD',FORM='UNFORMATTED') OPEN(22,FILE='SIG24A',STATUS='NEW',RECL=578,FORM='UNFORMATTED') OPEN(23,FILE='SIG24B',STATUS='NEW',RECL=2100,FORM='UNFORMATTED') ENDIF CJPB CCCC ISOP = .FALSE. WRITE(6,100) JCAP, LEVS 100 FORMAT (1H0, 'SMF', I2, I2, 'G CREATED JULY 8 1982') SATCRI=0.8 RELKUO=0.8 ACUMT=-1.E-7 FILTB = (1. - FILTA) * 0.5 CJPB CALL ERRSET (208, 0, -1, 1) CALL SETSIG(CI,SI,DEL,SL,CL,RPI) CALL AMHMTM(DEL,RPI,SV,P1,P2,AM,HM,TM) CALL GLATS ( 21 , COLRAD, WGT, WGTCS, RCS2) CALL EPSLON (EPS, 16 ) DO 4 LEV=1, 7 4 TOV(LEV)=300. CJPB CALL PRMFLD(NUM) CALL PRMFLD(NUM,IOPEN) IF(NUM(18).NE.0)MODS=NUM(18) IF(NUM(19).NE.0)NITER=NUM(19) N1=NUM(1) N2=NUM(2) N3=NUM(3) N4=NUM(4) IBRAD=NUM(5) ISEMI=NUM(6) NFILES=NUM(11) NF=NUM(12) CALL 1 GRDLNF(N1,FHOUR,IDATE,DPHI,DLAM,GZ,QM,TEM,DIM,ZEM,RM,SL,SI) REWIND N1 CCCC IF(ISOP) CALL SHOWHR(FHOUR,1) CALL 1 GRDLNF(N2,FHOUR,IDATE,DPHI,DLAM,GZ,Q,TE,DI,ZE,RQ,SL,SI) IF(N1.EQ.N2) GO TO 801 C N1.NE.N2 *** IF FHOUR=MOD12 ZERO RAIN,IF NOT READ FROM SIG B FILE IHOUR=FHOUR+0.5 MOD12=MOD(IHOUR,12) IF(MOD12.EQ.0)CALL XSTORE(GESHEM(1,1),0., 50 * 42 ) IF(MOD12.NE.0)READ(N2) GESHEM 777 CONTINUE GO TO 802 801 CONTINUE CALL XSTORE(GESHEM(1,1),0., 50 * 42 ) 802 CONTINUE REWIND N2 IFINAL=NUM(15) ISST=NUM(16) CALL GSSTCD(Z00,SATCRI,ISST) DK=NUM(9) DK=DK*10.**NUM(10) TK=NUM(20) TK=TK*10.**NUM(21) IF(NUM(20).EQ.0)TK=DK WRITE(6,105)SATCRI,RELKUO,ACUMT,DT,FILTA,DK,TK 105 FORMAT(1H ,F4.2,1X,F4.2,1X,E8.2,1X,F5.0,1X,F4.2,1X,E8.2,1X,E8.2) C-------------------------------------------------------------- IF(IBRAD.EQ.1) 1 CALL GNMINI(DK,TK,SATCRI,DISPK,PERCUT,MODS,NITER,NF) IF(NUM(13).EQ.0) GO TO 5 NI=NUM(14) CALL GWRITE(NI,SHOUR,IDATE,Z,Q,TE,DI,ZE,RQ,SL,SI,GZ,Z00) REWIND NI 5 CONTINUE C-------------------------------------------------------------- IF(N1.NE.N2) GO TO 6000 LIMLOW=2 C**************************************************************** C*** FIRST STEP IS FORWARD. CORRESPONDS TO DT/2 IN SEMI-IMPLICIT C**************************************************************** DT= 1029. /4. DO 5000 JDT=1,2 KDT=JDT CALL DRUK(EPS,PLN,Q,PS,QF,KDT) CALL BMCM (TOV,P1,P2,H1,H2,DEL,CI,BM,CM,DT,SV,AM) CALL GLOOP(TPS) CALL DEL4(DK,TK,DER,RT,RM,X,DIM,Y,TEM,W,ZEM,Z,QM) IF(ISEMI.EQ.1)CALL SICDKD 1 (DIM,TEM,QM,X,Y,Z,AM,BM,CM,TOV,SV,DT,ZEM,W,GZ,DISPK) IF(ISEMI.NE.1)CALL SIBCKD 1 (DIM,TEM,QM,X,Y,Z,AM,BM,CM,TOV,SV,DT,ZEM,W,GZ,DISPK) DO 1003 LEV=1, 7 DO 1003 I=1, 289 DI(I,LEV)=X(I,LEV) TE(I,LEV)=Y(I,LEV) ZE(I,LEV)=W(I,LEV) 1003 CONTINUE DO 1004 I=1, 289 Q(I) = Z(I) 1004 CONTINUE CALL GWATER(FILTA,DT,0,SATCRI,ACUMT,RELKUO,NUN,NKUO) DT=2.*DT 5000 CONTINUE SHOUR=DT C**************************************************************** C*** END SMOOTH START C**************************************************************** 6000 CONTINUE MAXSTP=NUM(7) ISTEPS=NUM(8) XHOUR=SHOUR DO 20000 ISTEP=1,ISTEPS C************************************************* C***** TIME LOOP C************************************************* C CALL BMCM (TOV,P1,P2,H1,H2,DEL,CI,BM,CM,DT,SV,AM) DO 10000 JDT=LIMLOW,MAXSTP KDT=JDT CALL DRUK(EPS,PLN,Q,PS,QF,KDT) SHOUR=SHOUR+DT XHOUR=XHOUR+DT CHOUR=SHOUR/3600. IHOUR=CHOUR+0.5 CHOUR=IHOUR THOUR=FHOUR+CHOUR CALL GLOOP(TPS) CALL DEL4(DK,TK,DER,RT,RM,X,DIM,Y,TEM,W,ZEM,Z,QM) IF(ISEMI.EQ.1)CALL SICDKD 1 (DIM,TEM,QM,X,Y,Z,AM,BM,CM,TOV,SV,DT,ZEM,W,GZ,DISPK) IF(ISEMI.NE.1)CALL SIBCKD 1 (DIM,TEM,QM,X,Y,Z,AM,BM,CM,TOV,SV,DT,ZEM,W,GZ,DISPK) CALL FILTER (TEM,TE,Y,DIM,DI,X,ZEM,ZE,W,QM,Q,Z,FILTA) CALL GWATER(FILTA,DT,1,SATCRI,ACUMT,RELKUO,NUN,NKUO) C*** COMPLETE TIME FILTER OF T(N-1). TE IS NOW ADJUSTED T(N+1) DO 6 K=1, 7 DO 6 I=1, 289 TEM(I,K)=CMPLX( REAL(TEM(I,K))+FILTB* REAL(TE(I,K)) , 1 AIMAG(TEM(I,K))+FILTB*AIMAG(TE(I,K)) ) 6 CONTINUE IF(XHOUR.LT.10800.) GO TO 10000 CCCC IF(ISOP) CALL SHOWHR(THOUR,4) XHOUR=0. 10000 CONTINUE C************************************************ C***** END TIME LOOP C************************************************ WRITE(6,102)DT,CHOUR 102 FORMAT(1H0,'TIME STEP ',F8.1,2X,'FCST SEGMENT OF ',F7.2,' H') IF(ISTEP.EQ.2)N4=NUM(17) CALL GWRITE(N4,THOUR,IDATE,Z,Q,TE,DI,ZE,RQ,SL,SI,GZ,Z00) WRITE (N4) GESHEM REWIND N4 IHOUR=THOUR+0.5 MOD12=MOD(IHOUR,12) IF(MOD12.EQ.0)CALL XSTORE(GESHEM(1,1),0., 50 * 42 ) LIMLOW=1 20000 CONTINUE CALL GWRITE(N3,THOUR,IDATE,Z,QM,TEM,DIM,ZEM,RM,SL,SI,GZ,Z00) REWIND N3 C(DEBUGLINE) VERSION CREATED JULY 8 1982 BY J.SELA,NMC. CJPB IF(IOPEN.EQ.1)THEN CLOSE(19) CLOSE(20) CLOSE(21) ELSE CLOSE(22) CLOSE(23) ENDIF CJPB STOP END