!
!***********************************************************************
!
      SUBROUTINE wrtout(lent,levs,lsoil,ntrac,ntoz,ntcw,ncld,nmtvr,
     &    u, v, t, q, ps,geshem, xlon, xlat,
     &    colat1,SL,SI,idate,fhour,zhour,fhswr,fhlwr,
     &    TSEA,SMC,SHELEG,STC,TG3,ZORL,CV,CVB,
     &    CVT,ALVSF,ALVWF,ALNSF,ALNWF,SLMSK,VFRAC,CANOPY,F10M,
     &    VTYPE,STYPE,FACSF,FACWF,UUSTAR,FFMM,FFHH,
     &    hice,fice,tisfc,tprcp,srflag,slc,snwdpth,slope,
     &    shdmin,shdmax,snoalb,sfalb,
     &    ICEN,IGEN,ICEN2,
     & tmpmax,tmpmin,runoff,t2m,q2m,psurf,dvgwd,hpbl,pwat,ep,
     & dugwd,v10m,dtsfc,dqsfc,gflux,dusfc,dvsfc,bengsh,
     & cldwrk,u10m,fluxr,dlwsfc,ulwsfc,dt3dt,dq3dt,cldcov, LDIAG3D
     &,   du3dt, dv3dt, phy_f3d, phy_f2d, num_p3d, num_p2d,
     & dudt11, dvdt11, dtdt11, dqdt11, dpdt11, vvel11)
     
!
      USE MACHINE , ONLY : kind_io4,kind_io8
      implicit none
!     include 'resolution.h'
!
      integer lent,levs,lsoil,ntrac,ntoz,ntcw,ncld,nmtvr
     &,       num_p3d, num_p2d
      real phy_f3d(LENT,LEVS,num_p3d), phy_f2d(LENT,num_p2d)
      real U(LENT,LEVS),       V(LENT,LEVS), T(LENT,LEVS),
     &     Q(LENT,LEVS,NTRAC), PS(LENT), xlon(lent), xlat(lent)
      real sl(levs),si(levs+1),fhour,zhour
!
      real SMC(LENT,LSOIL),STC(LENT,LSOIL),
     &     TSEA  (LENT), SHELEG(LENT), TG3   (LENT),
     &     ZORL  (LENT), CV    (LENT), CVB   (LENT),
     &     CVT   (LENT), ALVSF (LENT), ALVWF (LENT),
     &     ALNSF (LENT), ALNWF (LENT), SLMSK (LENT),
     &     VFRAC (LENT), CANOPY(LENT), F10M  (LENT),
     &     VTYPE (LENT), STYPE (LENT), FACSF (LENT),
     &     FACWF (LENT), UUSTAR(LENT), FFMM  (LENT),
     &     FFHH  (LENT), GESHEM(LENT),
     &     hice(lent), fice(lent),tisfc(lent),
     &     tprcp(lent), slc(lent,lsoil),
     &     snwdpth(lent), slope(lent), shdmin(lent),
     &     shdmax(lent), snoalb(lent), sfalb(lent), 
     &     srflag(lent)

      real tmpmax(LENT), tmpmin(LENT), runoff(LENT),
     &        t2m(LENT),    q2m(LENT),  psurf(LENT),
     &      dvgwd(LENT),   hpbl(LENT),   pwat(LENT),
     &         ep(LENT),  dugwd(LENT),   v10m(LENT),
     &      dtsfc(LENT),  dqsfc(LENT),  gflux(LENT),
     &      dusfc(LENT),  dvsfc(LENT), bengsh(LENT),
     &     cldwrk(LENT),   u10m(LENT),
     &     dlwsfc(LENT), ulwsfc(LENT), fluxr(27,LENT)

      real dt3dt(LENT,LEVS,6), dq3dt(LENT,LEVS,7)
     &,    du3dt(LENT,LEVS,3), dv3dt(LENT,LEVS,3)
     &,    cldcov(lent,levs)
      integer idate(4),nosig,nosfc,noflx,ndigyr,iostat,no3d
      integer jdate(4),ks,kh,km,ndig
      character CFHOUR*16,CFORM*40,CIDATE*10
      logical lfnhr, LDIAG3D
      real secphy,secswr,seclwr,fhswr,fhlwr,colat1
      integer ICEN,IGEN,ICEN2,IENST,IENSI

! dpdt should be (1000Pa)/second;  vvel in Pa/second; wn0 in (1000Pa/second)
      real    dudt11(lent,levs), dvdt11(lent,levs), dtdt11(lent,levs),
     &        dqdt11(lent,levs,ntrac), dpdt11(lent), vvel11(lent,levs)

c
csela if(me.eq.0) print*,'from subr. wrtout                fhour=',fhour  
c     CREATE CIDATE AND CFHOUR
      JDATE=IDATE
      ndigyr=4
      IF(NDIGYR.EQ.2) THEN
        JDATE(4)=MOD(IDATE(4)-1,100)+1
csela   WRITE(CIDATE,'(4I2.2)') JDATE(4),JDATE(2),JDATE(3),JDATE(1)
      ELSE
csela   WRITE(CIDATE,'(I4.4,3I2.2)') JDATE(4),JDATE(2),JDATE(3),JDATE(1)
      ENDIF

csela set lfnhr to false for writing one step output etc.
!      lfnhr=.true.
      lfnhr=.false.
      IF(LFNHR) THEN
        KH=NINT(FHOUR)
        NDIG=MAX(LOG10(KH+0.5)+1.,2.)
        WRITE(CFORM,'("(I",I1,".",I1,")")') NDIG,NDIG
        WRITE(CFHOUR,CFORM) KH
      ELSE
        KS=NINT(FHOUR*3600)
        KH=KS/3600
        KM=(KS-KH*3600)/60
        KS=KS-KH*3600-KM*60
        NDIG=MAX(LOG10(KH+0.5)+1.,2.)
        WRITE(CFORM,'("(I",I1,".",I1,",A1,I2.2,A1,I2.2)")') NDIG,NDIG
        WRITE(CFHOUR,CFORM) KH,':',KM,':',KS
      ENDIF

      nosig=61
      OPEN(NOSIG,FILE='SIG.F'//CFHOUR,FORM='UNFORMATTED')
      CALL TWRITE(nosig,LEVS,ntrac,SI,SL,FHOUR,ICEN,IGEN,jdate,
     &            ntoz, ntcw, ncld,
     &            U, V, T, Q, PS, lent, xlon, xlat
     &,           phy_f3d, phy_f2d, num_p3d, num_p2d)

      CLOSE(NOSIG)

      print*,'called para_twrite from wrtout fhour=',fhour  
      nosfc=62
      OPEN(NOSFC,FILE='SFC.F'//CFHOUR,FORM='UNFORMATTED')
      CALL FIXIO_W(TSEA,SMC,SHELEG,STC,TG3,ZORL,CV,CVB,
     &           CVT,ALVSF,ALVWF,ALNSF,ALNWF,SLMSK,VFRAC,CANOPY,F10M,
     &           VTYPE,STYPE,FACSF,FACWF,UUSTAR,FFMM,FFHH,
     &           hice,fice,tisfc,tprcp,srflag,slc,snwdpth,slope,
     &           shdmin,shdmax,snoalb,sfalb,
     &           nosfc,lent,lsoil,nmtvr,fhour,jdate)
      CLOSE(NOSFC)
!     print*,'called para_fixio_w from wrtout fhour=',fhour  

      SECPHY = (FHOUR-ZHOUR)*3600.
      SECSWR = MAX(SECPHY,FHSWR*3600.)
      SECLWR = MAX(SECPHY,FHLWR*3600.)
      noflx=63
!     call BAOPEN(NOFLX,'FLX.F'//CFHOUR,iostat)
      OPEN(NOFLX,FILE='FLX.F'//CFHOUR,FORM='UNFORMATTED')
      call  WRTSFC(noflx,ZHOUR,FHOUR,IDATE,colat1,SECSWR,SECLWR,si,
     &             ICEN,IGEN,ICEN2,IENST,IENSI, lent, levs, lsoil,
     &  dusfc,dvsfc,dtsfc,dqsfc,tsea,smc,stc,gflux,fluxr,dlwsfc,ulwsfc,
     &  sheleg,geshem,bengsh,cldwrk,u10m,v10m,t2m,q2m,psurf,
     &  tmpmax,tmpmin,runoff,ep,dugwd,dvgwd,hpbl,pwat,cv,cvt,cvb,slmsk)
csela
!     call baCLOSE(noflx,iostat)
      CLOSE(NOflx)
      call wrtlog(fhour,idate)
!
      if (LDIAG3D) then
        no3d=64
!       call BAOPEN(NO3D,'D3D.F'//CFHOUR,iostat)
        OPEN(NO3D,FILE='D3D.F'//CFHOUR,FORM='UNFORMATTED')
        call  WRT3D(no3d,ZHOUR,FHOUR,IDATE,dt3dt,dq3dt,cldcov,
     &              du3dt, dv3dt,
     &              u, v, t, q, ps, lent, levs, ntrac,secswr,
     &       	    dudt11, dvdt11, dtdt11, dqdt11, dpdt11, vvel11)
csela
!       call baCLOSE(no3d,iostat)
        CLOSE(NO3D)
        print*,'called wrt3d       from wrtout fhour=',fhour  
      endif
      RETURN
      END
c
c***********************************************************************
c
      SUBROUTINE wrt_restart(U,V,T,Q,PS,U1,V1,T1,Q1,PS1,xlon,xlat,
     &    TSEA,SMC,SHELEG,STC,TG3,ZORL,CV,CVB,
     &    CVT,ALVSF,ALVWF,ALNSF,ALNWF,SLMSK,VFRAC,CANOPY,F10M,
     &    VTYPE,STYPE,FACSF,FACWF,UUSTAR,FFMM,FFHH,
     &    hice,fice,tisfc,tprcp,srflag,slc,snwdpth,slope,
     &    shdmin,shdmax,snoalb,sfalb,
     &    geshem,SI,SL,fhour,idate,lent,levs,ntrac,lsoil,nmtvr
     &,   phy_f3d, phy_f2d, num_p3d, num_p2d)
!    &    geshem,SI,SL,fhour,idate,me,latd,nlats,latsinpe,lonsinpe)  
c
c***********************************************************************
c
!     implicit none
!     include 'resolution.h'
!     integer latd,nlats,latsinpe(LATD),lonsinpe(2,LATD)
      integer lent,levs,ntrac,lsoil,nmtvr
     &,       num_p3d, num_p2d
!     REAL  GZ(LNTD,2)
!     REAL  oz(lntd,2),ze(lntd,2),di(lntd,2)
!     REAL  te(lntd,2),rq(lntd,2), q(lntd,2)
!     REAL  ozm(lntd,2),zem(lntd,2),dim(lntd,2)
!     REAL  tem(lntd,2), rm(lntd,2), qm(lntd,2)
!
      real phy_f3d(LENT,LEVS,num_p3d), phy_f2d(LENT,num_p2d)
      real U(LENT,LEVS),       V(LENT,lEVS),  T(LENT,LEVS)
     &,    Q(LENT,LEVS,NTRAC), PS(LENT)
      real U1(LENT,LEVS),      V1(LENT,lEVS), T1(LENT,LEVS)
     &,    Q1(LENT,LEVS,NTRAC), PS1(LENT)
      real xlon(lent),          xlat(lent)
      real sl(levs),si(levs+1),fhour
      real SMC(LENT,LSOIL), STC(LENT,LSOIL),
     &     TSEA  (LENT), SHELEG(LENT), TG3   (LENT),
     &     ZORL  (LENT), CV    (LENT), CVB   (LENT),
     &     CVT   (LENT), ALVSF (LENT), ALVWF (LENT),
     &     ALNSF (LENT), ALNWF (LENT), SLMSK (LENT),
     &     VFRAC (LENT), CANOPY(LENT), F10M  (LENT),
     &     VTYPE (LENT), STYPE (LENT), FACSF (LENT),
     &     FACWF (LENT), UUSTAR(LENT), FFMM  (LENT),
     &     FFHH  (LENT), GESHEM(LENT),
     &     hice(lent), fice(lent),tisfc(lent),
     &     tprcp(lent), slc(lent,lsoil),
     &     snwdpth(lent), slope(lent), shdmin(lent),
     &     shdmax(lent), snoalb(lent), sfalb(lent), 
     &     srflag(lent)
      integer idate(4),n3,n4,nflop
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      print*,'writing restart files fhour in wrt_res=',fhour  

      n3=51
      CALL TWRITE(n3,LEVS,ntrac,SI,SL,FHOUR,ICEN,IGEN,idate,
     &            ntoz, ntcw, ncld,
     &            U, V, T, Q, PS, lent, xlon, xlat
     &,           phy_f3d, phy_f2d, num_p3d, num_p2d)
      CLOSE(n3)

      n4=52
      CALL TWRITE(n4,LEVS,ntrac,SI,SL,FHOUR,ICEN,IGEN,idate,
     &            ntoz, ntcw, ncld,
     &            U1, V1, T1, Q1, PS1, lent, xlon, xlat
     &,           phy_f3d, phy_f2d, num_p3d, num_p2d)
      CLOSE(n4)

      nflop=53
      CALL FIXIO_W(TSEA,SMC,SHELEG,STC,TG3,ZORL,CV,CVB,
     &           CVT,ALVSF,ALVWF,ALNSF,ALNWF,SLMSK,VFRAC,CANOPY,F10M,
     &           VTYPE,STYPE,FACSF,FACWF,UUSTAR,FFMM,FFHH,
     &           hice,fice,tisfc,tprcp,srflag,slc,snwdpth,slope,
     &           shdmin,shdmax,snoalb,sfalb,
     &           nflop,lent,lsoil,nmtvr,fhour,idate)
      CLOSE(nflop)

      RETURN
      END

      SUBROUTINE wrtlog(fhour,idate)                      
      implicit none
!     include 'resolution.h'

      integer idate(4),ndigyr,nolog
      integer ks,kh,km,ndig
      character CFHOUR*16,CFORM*40,CIDATE*10
      logical lfnhr
      real fhour                                   
c
c     CREATE CIDATE AND CFHOUR

csela set lfnhr to false for writing one step output etc.
!      lfnhr=.true.
      lfnhr=.false.
      IF(LFNHR) THEN
        KH=NINT(FHOUR)
        NDIG=MAX(LOG10(KH+0.5)+1.,2.)
        WRITE(CFORM,'("(I",I1,".",I1,")")') NDIG,NDIG
        WRITE(CFHOUR,CFORM) KH
      ELSE
        KS=NINT(FHOUR*3600)
        KH=KS/3600
        KM=(KS-KH*3600)/60
        KS=KS-KH*3600-KM*60
        NDIG=MAX(LOG10(KH+0.5)+1.,2.)
        WRITE(CFORM,'("(I",I1,".",I1,",A1,I2.2,A1,I2.2)")') NDIG,NDIG
        WRITE(CFHOUR,CFORM) KH,':',KM,':',KS
      ENDIF

      nolog=99
      OPEN(NOlog,FILE='LOG.F'//CFHOUR,FORM='FORMATTED')
      write(nolog,100)fhour,idate
100   format(' completed mrf fhour=',f10.3,2x,4(i4,2x))
      CLOSE(NOlog)

      RETURN
      END
      SUBROUTINE  WRT3D(no3d,ZHOUR,FHOUR,IDATE,dt3dt,dq3dt,cldcov,
     &                  du3dt, dv3dt,
     &                  u, v, t, q, ps, lent, levs, ntrac, secswr,
     &        		dudt11, dvdt11, dtdt11, dqdt11, dpdt11, vvel11)
      USE MACHINE , ONLY : kind_io4,kind_io8
      implicit none
      integer lent,levs, ntrac, no3d, idate(4)
      real zhour, fhour, rtime, secswr
      real dt3dt(lent,levs,6), dq3dt(lent,levs,7), cldcov(lent,levs)
     &,    du3dt(LENT,LEVS,3), dv3dt(LENT,LEVS,3)
      real    dudt11(lent,levs), dvdt11(lent,levs), dtdt11(lent,levs),
     &        dqdt11(lent,levs,ntrac), dpdt11(lent), vvel11(lent,levs)
      real u(lent,levs), v(lent,levs), t(lent,levs),
     &     q(lent,levs,ntrac)
      real ps(lent)
      real (kind=kind_io4) wrk(lent)
      integer n, l
!
      IF(FHOUR.GT.ZHOUR) THEN
        RTIME=1./(3600.*(FHOUR-ZHOUR))
      ELSE
        RTIME=0.
      ENDIF
      DO N=1,6
        DO L=1,LEVS
          wrk(:) = dt3dt(:,L,N) * RTIME
          WRITE(no3d) wrk
!     if((fhour .eq. 68*3) .and. n .eq. 4)
!    * print *,' L=',L,' dt3dt=',dt3dt(1,l,4),' wrk=',wrk,' fhour='
!    *,fhour
        ENDDO
      ENDDO
    1 format(5x,E14.4)
      DO N=1,4
        DO L=1,LEVS
          wrk(:) = dq3dt(:,L,N) * RTIME
          WRITE(no3d) wrk
        ENDDO
      ENDDO
!
      DO N=1,3
        DO L=1,LEVS
          wrk(:) = du3dt(:,L,N) * RTIME
          WRITE(no3d) wrk
        ENDDO
      ENDDO
!
      DO N=1,3
        DO L=1,LEVS
          wrk(:) = dv3dt(:,L,N) * RTIME
          WRITE(no3d) wrk
        ENDDO
      ENDDO
!
      IF(SECSWR.GT.0.) THEN
        RTIME=1./SECSWR
      ELSE
        RTIME=1.
      ENDIF
      DO L=1,LEVS
        wrk(:) = cldcov(:,L) * RTIME
        WRITE(no3d) wrk
      ENDDO
!
      DO L=1,LEVS
        wrk(:) = u(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO L=1,LEVS
        wrk(:) = v(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO L=1,LEVS
        wrk(:) = t(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO N=1,NTRAC
        DO L=1,LEVS
          wrk(:) = q(:,L,N)
          WRITE(no3d) wrk
        ENDDO
      ENDDO
      wrk(:) = ps(:)
      WRITE(no3d) wrk
      DO L=1,LEVS
        wrk(:) = dudt11(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO L=1,LEVS
        wrk(:) = dvdt11(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO L=1,LEVS
        wrk(:) = dtdt11(:,L)
        WRITE(no3d) wrk
      ENDDO
      DO N=1,NTRAC
      DO L=1,LEVS
        wrk(:) = dqdt11(:,L,N)
        WRITE(no3d) wrk
      ENDDO
      ENDDO
      wrk(:) = dpdt11(:)
      WRITE(no3d) wrk
      DO L=1,LEVS
        wrk(:) = vvel11(:,L)
        WRITE(no3d) wrk
      ENDDO
!
      RETURN
      END