!,&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&      
      program out4mpi
!***********************************************************************
!                                                                      *
!         Output for mpi run                                           *
!                                                                      *
!***********************************************************************
      implicit none
      include "param_o.h"
      include "fcstdata.h"
      include 'const.h'

!-----------------------------------------------------------------------
      real, dimension (0:im+1,0:jm+1,nm) :: pd,tg
      real, dimension (0:im+1,0:jm+1,nm,lm) :: t, q, u, v

      common /vrbls_prp/ pd, t, q, u, v
!-----------------------------------------------------------------------
! For common /dynam/ 
!-----------------------------------------------------------------------
      real ::  fadv, fadt, rd,  f4d, ef4t, fkin, fcp  ,fadv2   
      real, dimension (lm) :: deta, rdeta, aeta, daeta,f4q2
      real, dimension (lp1) :: eta, dfl
      real, dimension (0:im+1,0:jm+1,nm) :: wpdar, f11, f12, f21, f22, &
                                    p11, p12, p21, p22, fdiv, fddmp &
                                    ,hsinp,hcosp,fvdiff,DXVDX, DXVDY, DYVDX, &
             DYVDY, DZVDX, DZVDY, RSQV, VCOSP, VSINP, VLAM, VPHI, RSQH,  &
             HLAM, HPHI,qbv11,qbv12,qbv22

!-----------------------------------------------------------------------
! For common /ctlblk/
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      real, dimension (0:im+1,0:jm+1,nm) :: sqv, sqh, q11, q12, q22,hbmsk, &
                                      qh11,qh12,qh22
      real,dimension(0:im+1,0:jm+1,nm,4)::qd11,qd12,qd21,qd22
      common /metrcs_prp/ sqv, sqh, q11, q12, q22
!-----------------------------------------------------------------------
      character(len=3) ftag
      character (len=256) :: filename,fname1,init_out,mpi_out
      integer::i,j,n,l,list20,list21,list22,list23,mype,iy,jmax,ix,jmin &
         ,imax,i1,j1,imin
      real,dimension(0:im+1,0:jm+1,nm,lm)::ktdt
      real,dimension(lm)::kvdt
      real::delty,delthz,kappa,p0,rtdf
      real,dimension(0:im+1,0:jm+1,nm)::fis,res,sst,epsr,sm,sice,vegfrc &
                   ,sno,albedo,si,albase,mxsnal,sst1,hgtsub
      integer,dimension(0:im+1,0:jm+1,nm)::lmh,lmv,ivgtyp,isltyp,islope
      real,dimension(0:im+1,0:jm+1,nm,lm)::htm,vtm
      real,dimension(0:im+1,0:jm+1,nm,4)::z0eff
      real,dimension(0:im+1,0:jm+1,nm,4)::smc,stc,sh2o
      real,dimension(0:im+1,0:jm+1,nm,4,2,2)::qvh,qhv,qvh2,qhv2
      real,dimension(0:im+1,0:jm+1,nm,8,2,2)::qintc1,qintc2
      real,dimension(0:im+1,0:jm+1,nm,13,2,2)::qa
      real,dimension(0:im+1,0:jm+1,nm,2,2)::qb
      integer::i2,j2,nd,ndays
      character(len=3)::cn

      lvsst=.false.

      read(5,'(a)')init_out
      read(5,'(a)')mpi_out

!-----------------------------------------------------------------------

! ***  Output from "vrbls"

      list20 = 20
      open(list20, file=init_out,form ="unformatted")
      read(list20) pd, t,q, u, v,tg,smc,stc
      close(list20)


!-----------------------------------------------------------------------

! ***  Output from "const"
 
      list21 = 21
      open(list21, file="../data_out/dynam.dat",form ="unformatted")
      read(list21) fadv,fadv2, fadt, rd,  f4d,f4q2, ef4t, fkin, deta, rdeta, aeta, eta, dfl, &
                   daeta, wpdar, f11, f12, f21, f22, p11, p12, p21, p22, fcp, fdiv, fddmp &
                   ,hsinp,hcosp,delty,delthz,kappa,p0,rtdf,fvdiff,hbmsk
      close(list21)
      
      list22 = 22
      open(list22, file="../data_out/ctlblk.dat",form ="unformatted")
      read(list22) run,idat,ihrst,first,restrt,nfcst,nbc,list, &
             ntsd,nddamp,nprec,nboco,nshde,ncp, &
             subpost,ntddmp
      close(list22)
      print *,sigma,run,idat
      print *,im,jm,nm,lm
      print *,'dt,ntstm,',dt,ntstm,ntstm*dt/(3600*24)
      
      list23 = 23
      open(list23, file="../data_in/grid/gridinit.dat", &
       form ="unformatted")
      read(list23) sqv, sqh, q11, q12, q22,DXVDX, DXVDY, DYVDX, &
       DYVDY, DZVDX, DZVDY, RSQV, VCOSP, VSINP, VLAM, VPHI, RSQH, HCOSP, &
       HSINP, HLAM, HPHI,qd11,qd12,qd21,qd22,qvh,qhv,qbv11,qbv12,qbv22  &
       ,qvh2,qhv2,qh11,qh12,qh22
      close(list23)
      
      list23 = 23
      open(list23, file="../data_in/grid/zeff.dat",form ="unformatted")
      read(list23)z0eff
      close(list23)

!      open(list23,file='../data_in/grid/topo_sub.dat',form='unformatted')
!      read(list23)hgtsub
!      close(list23)

      open(list21,file="../data_out/hs.dat",form="unformatted")
      read(list21)kvdt,ktdt
      close(list21)
      
       open(1,file='../data_out/sfceta2.dat',form='unformatted')
       read(1)sst,epsr,sm,sice,si,sno,vegfrc,ivgtyp  &
	       ,isltyp,islope,sh2o,albedo,albase,mxsnal
       close(1)


	open(1,file='../data_out/sfceta.dat',form='unformatted')
	read(1)fis,res,htm,vtm,lmh,lmv
	close(1)

!      open(21,file='../data_in/grid/qintc_2.dat',form='unformatted')
!      read(21)qa
!DRAGAN      read(21)qb
!      close(21)


	do n=1,nm
	do i=0,101
	do j=0,101
!	  print *,i,j,n,t(i,j,n,38)
        enddo
	enddo
	enddo

!-----------------------------------------------------------------------
       mype = 0
      do n=1,nm
        jmin = 0
      do iy = 1,jym
        jmax = jmin + (jlm - 1)
        j1 = jmin
        imin = 0
      do ix = 1,ixm
        imax = imin + (ilm -1)
        i1 = imin 
!-----------------------------------------------------------------------
         write(ftag, 100) mype
 100     format(i3.3)
!-----------------------------------------------------------------------
         filename=trim(mpi_out)//ftag
         open(unit = 10, file=TRIM(filename),form='unformatted')
	 if(nm.eq.14)then
            call a2aloc(pd , i1, j1, n, 1 , 10 )
            call a2aloc(t  , i1, j1, n, lm, 10 )
            call a2aloc(q  , i1, j1, n, lm, 10 )
            call a2aloc(u  , i1, j1, n, lm, 10 )
            call a2aloc(v  , i1, j1, n, lm, 10 )
            call a2aloc(tg  , i1, j1, n,1, 10 )
	 else
            call a2al(pd , i1, j1, n, 1 , 10 )
            call a2al(t  , i1, j1, n, lm, 10 )
            call a2al(q  , i1, j1, n, lm, 10 )
            call a2al(u  , i1, j1, n, lm, 10 )
            call a2al(v  , i1, j1, n, lm, 10 )
            call a2al(tg  , i1, j1, n, 1, 10 )
         endif
         close( 10 )
!-----------------------------------------------------------------------
         filename='../DataForMpi/const.'//ftag
         open(unit = 11, file=filename,form='unformatted')

         if(nm.eq.14)then
            call a2aloc(sqv, i1, j1, n, 1, 11 )
            call a2aloc(sqh, i1, j1, n, 1, 11 )
            call a2aloc(q11, i1, j1, n, 1, 11 )
            call a2aloc(q12, i1, j1, n, 1, 11 )
            call a2aloc(q22, i1, j1, n, 1, 11 )
            call a2aloc(qh11, i1, j1, n, 1, 11 )
            call a2aloc(qh12, i1, j1, n, 1, 11 )
            call a2aloc(qh22, i1, j1, n, 1, 11 )
            do i=1,4
              call a2aloc(qd11(:,:,:,i),i1,j1,n,1,11)
              call a2aloc(qd12(:,:,:,i),i1,j1,n,1,11)
              call a2aloc(qd21(:,:,:,i),i1,j1,n,1,11)
              call a2aloc(qd22(:,:,:,i),i1,j1,n,1,11)
            enddo

	    do i=1,4
	    do i2=1,2
	    do j2=1,2
              call a2aloc(qvh(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2aloc(qhv(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2aloc(qvh2(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2aloc(qhv2(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
            enddo

 	    do i=1,8
	    do i2=1,2
	    do j2=1,2
!              call a2aloc(qintc1(:,:,:,i,i2,j2),i1,j1,n,1,11)
!              call a2aloc(qintc2(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
            enddo

 	    do i2=1,2
	    do j2=1,2
 	    do i=1,13
              call a2aloc(qa(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
              call a2aloc(qb(:,:,:,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
 
            call a2aloc(qbv11, i1, j1, n, 1, 11 ) 
            call a2aloc(qbv12, i1, j1, n, 1, 11 ) 
            call a2aloc(qbv22, i1, j1, n, 1, 11 ) 
            call a2aloc(wpdar, i1, j1, n, 1, 11 ) 
            call a2aloc(f11  , i1, j1, n, 1, 11 )
            call a2aloc(f12  , i1, j1, n, 1, 11 )
            call a2aloc(f21  , i1, j1, n, 1, 11 )
            call a2aloc(f22  , i1, j1, n, 1, 11 )
            call a2aloc(p11  , i1, j1, n, 1, 11 )
            call a2aloc(p12  , i1, j1, n, 1, 11 )
            call a2aloc(p21  , i1, j1, n, 1, 11 )
            call a2aloc(p22  , i1, j1, n, 1, 11 )
            call a2aloc(fdiv , i1, j1, n, 1, 11 )
            call a2aloc(fddmp, i1, j1, n, 1, 11 )
            call a2aloc(hsinp, i1, j1, n, 1, 11 )
            call a2aloc(hcosp, i1, j1, n, 1, 11 )
            call a2aloc(hlam, i1, j1, n, 1, 11 )
            call a2aloc(hphi, i1, j1, n, 1, 11 )
            call a2aloc(fvdiff, i1, j1, n, 1, 11 )
            call a2almskoc(hbmsk,i1,j1,n,1,11)
         else
            call a2al(sqv, i1, j1, n, 1, 11 )
            call a2al(sqh, i1, j1, n, 1, 11 )
            call a2al(q11, i1, j1, n, 1, 11 )
            call a2al(q12, i1, j1, n, 1, 11 )
            call a2al(q22, i1, j1, n, 1, 11 )
            call a2al(qh11, i1, j1, n, 1, 11 )
            call a2al(qh12, i1, j1, n, 1, 11 )
            call a2al(qh22, i1, j1, n, 1, 11 )
            do i=1,4
              call a2al(qd11(:,:,:,i),i1,j1,n,1,11)
              call a2al(qd12(:,:,:,i),i1,j1,n,1,11)
              call a2al(qd21(:,:,:,i),i1,j1,n,1,11)
              call a2al(qd22(:,:,:,i),i1,j1,n,1,11)
            enddo
 	    do i=1,4
	    do i2=1,2
	    do j2=1,2
              call a2al(qvh(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2al(qhv(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2al(qvh2(:,:,:,i,i2,j2),i1,j1,n,1,11)
              call a2al(qhv2(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
            enddo

 	    do i=1,8
	    do i2=1,2
	    do j2=1,2
!              call a2al(qintc1(:,:,:,i,i2,j2),i1,j1,n,1,11)
!              call a2al(qintc2(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
            enddo

  	    do i2=1,2
	    do j2=1,2
 	    do i=1,13
              call a2al(qa(:,:,:,i,i2,j2),i1,j1,n,1,11)
            enddo
              call a2al(qb(:,:,:,i2,j2),i1,j1,n,1,11)
            enddo
            enddo
 
            call a2al(qbv11, i1, j1, n, 1, 11 ) 
            call a2al(qbv12, i1, j1, n, 1, 11 ) 
            call a2al(qbv22, i1, j1, n, 1, 11 ) 
            call a2al(wpdar, i1, j1, n, 1, 11 ) 
            call a2al(f11  , i1, j1, n, 1, 11 )
            call a2al(f12  , i1, j1, n, 1, 11 )
            call a2al(f21  , i1, j1, n, 1, 11 )
            call a2al(f22  , i1, j1, n, 1, 11 )
            call a2al(p11  , i1, j1, n, 1, 11 )
            call a2al(p12  , i1, j1, n, 1, 11 )
            call a2al(p21  , i1, j1, n, 1, 11 )
            call a2al(p22  , i1, j1, n, 1, 11 )
            call a2al(fdiv , i1, j1, n, 1, 11 )
            call a2al(fddmp, i1, j1, n, 1, 11 )
            call a2al(hsinp, i1, j1, n, 1, 11 )
            call a2al(hcosp, i1, j1, n, 1, 11 )
            call a2al(hlam, i1, j1, n, 1, 11 )
            call a2al(hphi, i1, j1, n, 1, 11 )
            call a2al(fvdiff, i1, j1, n, 1, 11 )
            call a2almsk(hbmsk,i1,j1,n,1,11)
          endif

   write(11) deta, rdeta, aeta, daeta, eta, dfl, &
             fadv,fadv2, fadt, rd, pt, f4d, f4q2,ef4t, fkin,fcp,delty, &
             delthz,kappa,p0 ,rtdf   

   write(11) dt, idat, ihrst, nfcst, nbc, list,  iout, ntsd, ntstm, &    
             nddamp, nprec, idtad, nboco, nshde, ncp, nphs, &     
             ncnvc, nrads, nradl, ntddmp, &
             run, first, restrt, sigma, subpost,lcornerm,outstr, &
	     ndassim,ndassimm

    close(11)

       filename='../DataForMpi/hs.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12)kvdt
       call a2aloc(ktdt,i1,j1,n,lm,12)
       close(12)

       filename='../DataForMpi/dgns.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12)dgnnum,dgnstr,idgns,ickmm
       close(12)

       open(12,file='../DataForMpi/sfceta.'//ftag,form='unformatted')
       if(nm.eq.14)then
         call a2aloc(fis,i1,j1,n,1,12)
         call a2aloc(res,i1,j1,n,1,12)
         call a2aloc(htm,i1,j1,n,lm,12)
         call a2aloc(vtm,i1,j1,n,lm,12)
         call a2aloci(lmh,i1,j1,n,1,12)
         call a2aloci(lmv,i1,j1,n,1,12)
         call a2aloc(sst,i1,j1,n,1,12)
         call a2aloc(epsr,i1,j1,n,1,12)
         call a2aloc(sm,i1,j1,n,1,12)
         call a2aloc(sice,i1,j1,n,1,12)
         call a2aloc(si,i1,j1,n,1,12)
         call a2aloc(sno,i1,j1,n,1,12)
         call a2aloc(vegfrc,i1,j1,n,1,12)
         call a2aloci(ivgtyp,i1,j1,n,1,12)
         call a2aloci(isltyp,i1,j1,n,1,12)
         call a2aloci(islope,i1,j1,n,1,12)
         call a2aloc(sh2o,i1,j1,n,4,12)
         call a2aloc(albedo,i1,j1,n,1,12)
         call a2aloc(albase,i1,j1,n,1,12)
         call a2aloc(mxsnal,i1,j1,n,1,12)
         call a2aloc(smc,i1,j1,n,4,12)
         call a2aloc(stc,i1,j1,n,4,12)
         call a2aloc(z0eff,i1,j1,n,4,12)
!         call a2aloc(hgtsub,i1,j1,n,1,12)
       else
         call a2al(fis,i1,j1,n,1,12)
         call a2al(res,i1,j1,n,1,12)
         call a2al(htm,i1,j1,n,lm,12)
         call a2al(vtm,i1,j1,n,lm,12)
         call a2ali(lmh,i1,j1,n,1,12)
         call a2ali(lmv,i1,j1,n,1,12)
         call a2al(sst,i1,j1,n,1,12)
         call a2al(epsr,i1,j1,n,1,12)
         call a2al(sm,i1,j1,n,1,12)
         call a2al(sice,i1,j1,n,1,12)
         call a2al(si,i1,j1,n,1,12)
         call a2al(sno,i1,j1,n,1,12)
         call a2al(vegfrc,i1,j1,n,1,12)
         call a2ali(ivgtyp,i1,j1,n,1,12)
         call a2ali(isltyp,i1,j1,n,1,12)
         call a2ali(islope,i1,j1,n,1,12)
         call a2al(sh2o,i1,j1,n,4,12)
         call a2al(albedo,i1,j1,n,1,12)
         call a2al(albase,i1,j1,n,1,12)
         call a2al(mxsnal,i1,j1,n,1,12)
         call a2al(smc,i1,j1,n,4,12)
         call a2al(stc,i1,j1,n,4,12)
         call a2al(z0eff,i1,j1,n,4,12)
!         call a2al(hgtsub,i1,j1,n,1,12)
       endif

       close(12)

       filename='../DataForMpi/fcstdata.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12)tprec,theat,tclod,trdsw,trdlw,tsrfc
       close(12)

       if(lvsst)then
       ndays=ntstm*dt/(3600*24)

       do nd=1,ndays
	write(cn,'(i3.3)') nd
        fname1='../data_out/sst'//cn//'.dat'
	open(12,file=fname1,form='unformatted')
	read(12)sst1
	close(12)
	fname1='../DataForMpi/sst'//cn//'.'//ftag
	open(12,file=fname1,form='unformatted')
       if(nm.eq.14)then
         call a2aloc(sst1,i1,j1,n,1,12)
       else
         call a2al(sst1,i1,j1,n,1,12)
       endif
        close(12)
       enddo
       endif

!-----------------------------------------------------------------------
        imin = imax
        mype = mype + 1
      end do
        jmin = jmax
      end do
      end do
!test
       filename='../DataForMpi/dgnsserver.dat'
       open(unit=12,file=filename,form='unformatted')
       write(12)ntstm,dgnnum,dgnstr,idgns
       close(12)


        print *,'FINISH DECOMPOSITION'
!test
!-----------------------------------------------------------------------
        end program out4mpi
