      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
