!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&      
      program out4mpi
      implicit none
      include "param_o.h"
      call out4mpi_1(im,jm,nm,lm,ilm,jlm,ixm,jym)
      end program out4mpi

      subroutine out4mpi_1(im,jm,nm,lm,ilm,jlm,ixm,jym)
!***********************************************************************
!                                                                      *
!         Output for mpi run                                           *
!                                                                      *
!***********************************************************************
      implicit none

      integer(KIND=4), intent(in) :: im,jm,nm,lm,ilm,jlm,ixm,jym

      include 'fcstdata.h'
      include 'const.h'
      
!-----------------------------------------------------------------------
      real(KIND=4), dimension (0:im+1,0:jm+1,nm) :: pd,tg
      real(KIND=4), dimension (0:im+1,0:jm+1,nm,lm) :: t, q, u, v

!-----------------------------------------------------------------------
! For common /dynam/ 
!-----------------------------------------------------------------------
      real(KIND=4) ::  fadv, fadt, rd,  f4d, ef4t, fkin, fcp  ,fadv2!, msstt(IM+1,JM+1,nm,T)  
      real(KIND=4), dimension (lm) :: deta, rdeta, aeta, daeta,f4q2
      real(KIND=4), dimension (lm+1) :: eta, dfl
      real(KIND=4), 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!,sstm

!-----------------------------------------------------------------------
! For common /ctlblk/
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      real(KIND=4), dimension (0:im+1,0:jm+1,nm)                                                ::&
    & sqv, sqh, q11, q12, q22, hbmsk, qh11, qh12, qh22, sqv_norm
      real(KIND=4), dimension(0:im+1,0:jm+1,nm,4)                                               ::&
    & qd11, qd12, qd21, qd22

!-----------------------------------------------------------------------
      character(len=4) ftag
     
      character (len=256) :: filename,fname1,init_out,mpi_out,monthlysst
      integer(KIND=4)::i,j,n,l,list20,list21,list22,list23,mype,iy,jmax,ix,jmin &
              ,imax,i1,j1,imin, M
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,lm)::ktdt
      real(KIND=4),dimension(lm)::kvdt
      real(KIND=4)::delty,delthz,kappa,p0,rtdf
      real(KIND=4),dimension(0:im+1,0:jm+1,nm)::fis,res,sst,epsr,sm,sice,vegfrc &
                   ,sno,albedo,si,albase,mxsnal,sst1,hgtsub
                 
      


      real(KIND=4),dimension(0:im+1,0:jm+1,nm)::msstt      ! monthly sst
      logical(KIND=4):: lveg
      real(KIND=4):: vegfrm(0:im+1,0:jm+1,nm)                  ! monthly veg greeness             !DRAGAN, August 2011
      integer(KIND=4):: imo
      character(len=256)::green_mon
      character(len=2)::cn2
!
      INTEGER(KIND=4) :: I5, I3, J3, I6, I7
     

      integer(KIND=4),dimension(0:im+1,0:jm+1,nm)::lmh,lmv,ivgtyp,isltyp,islope
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,lm)::htm,vtm
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,4)::z0eff
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,4)::smc,stc,sh2o
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,4,2,2)                                            ::&
    & qvh, qhv, qvh2, qhv2
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,8,2,2)::qintc1,qintc2
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,13,2,2)::qa
      real(KIND=4),dimension(0:im+1,0:jm+1,nm,2,2)::qb
      integer(KIND=4)::i2,j2,nd,ndays, nmonths,nmon,INDAY,IOUTNUM,IIOUT,IHRST
    
      character(len=4)::cn
!  
!GSM      lvsst=.true.   ! variable SST     
      lvsst=.false.      ! DRAGAN, August 2011 
      !lveg=.true.       ! variable vegetation greeness  
      lveg=.false.
!
      read(5,'(a)')init_out
      read(5,'(a)')mpi_out
!
      NAMELIST /CNSTDATA/INDAY,IHRST,IDAT,IOUTNUM,IIOUT
!
      open(19,file='cnstdata',status='old')
      READ(19,CNSTDATA)
!-------------------- 
! Output from "vrbls"
!--------------------
      list20 = 20
      open(list20,file='init_out.dat',form ="unformatted")
      read(list20) pd, t, q, u, v, tg, smc, stc
      close(list20)
!-------------------- 
! Output from "const"
!-------------------- 
      list21 = 21
      open(list21, file='dynam.dat',status='old',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='ctlblk.dat',status='old',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='gridinit.dat',status='old',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,sqv_norm
      close(list23)
!      
      list23 = 23
      open(list23, file='zeff.dat',status='old',form ="unformatted")
      read(list23)z0eff
      close(list23)
!
      open(list21,file='hs.dat',status='old',form="unformatted")
      read(list21) kvdt, ktdt
      close(list21)
!      
      open(1,file='sfceta2.dat',status='old',form='unformatted')
      read(1) sst, epsr, sm, sice, si, sno, vegfrc, ivgtyp, isltyp, islope, sh2o, albedo, albase, mxsnal
!
      OPEN(666,file="SICE_OUT4MPI.txt")
      WRITE(666,*) SICE
      CLOSE(666)
!
      close(1)
!

!
       open(2,file='sfceta.dat',status='old',form='unformatted')
       read(2) fis, res, htm, vtm, lmh, lmv
       close(2)

      open(21,file='qintc_2.dat',status='old',form='unformatted')
      read(21) qa
      read(21) qb
      close(21)   ! related with the use of qintc.f90 or qintc_2.f90

!-----------------------------------------------------------------------
      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(i4.4)
 
!-----------------------------------------------------------------------
       filename='vrbls01.'//ftag  !****
        open(unit = 10, file=filename,form='unformatted')
!
        if (nm == 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)
        end if
!	
	close(10)
!-----------------------------------------------------------------------
        filename='const.'//ftag
        open(unit = 11, file=filename,form='unformatted')

        if (nm == 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)
            end do

           do i5=1,4
           do i2=1,2
           do j2=1,2
              call a2aloc(qvh (:, :, :, i5, i2, j2), i1, j1, n, 1, 11)
              call a2aloc(qhv (:, :, :, i5, i2, j2), i1, j1, n, 1, 11)
              call a2aloc(qvh2(:, :, :, i5, i2, j2), i1, j1, n, 1, 11)
              call a2aloc(qhv2(:, :, :, i5, i2, j2), i1, j1, n, 1, 11)
           end do
           end do
           end do
!
           do i3=1,2
           do j3=1,2
!
           do i6=1,13
              call a2aloc(qa(:, :, :, i6, i3, j3), i1, j1, n, 1, 11)
           end do
!
              call a2aloc(qb(:, :, :,     i3, j3), i1, j1, n, 1, 11)
           end do
           end do
! 
            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 )
            call a2al(sqv_norm, i1, j1, n, 1, 11 )
!
            do i5=1,4
                call a2al(qd11(:, :, :, i5), i1, j1, n, 1, 11)
                call a2al(qd12(:, :, :, i5), i1, j1, n, 1, 11)
                call a2al(qd21(:, :, :, i5), i1, j1, n, 1, 11)
                call a2al(qd22(:, :, :, i5), i1, j1, n, 1, 11)
            end do
!
           do i3=1,4
           do i2=1,2
           do j2=1,2
              call a2al(qvh (:, :, :, i3, i2, j2), i1, j1, n, 1, 11)
              call a2al(qhv (:, :, :, i3, i2, j2), i1, j1, n, 1, 11)
              call a2al(qvh2(:, :, :, i3, i2, j2), i1, j1, n, 1, 11)
              call a2al(qhv2(:, :, :, i3, i2, j2), i1, j1, n, 1, 11)
           end do
           end do
           end do
!
           do i2=1,2
           do j2=1,2
!
           do i7=1,13
              call a2al(qa(:, :, :, i7, i2, j2), i1, j1, n, 1, 11)
           end do
!
              call a2al(qb(:, :, :,     i2, j2), i1, j1, n, 1, 11)
           end do
           end do
! 
            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 )
        end if
!
       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,  iiout, 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='hs.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12) kvdt
       call a2aloc(ktdt, i1, j1, n, lm, 12)
       close(12)
!
       filename='dgns.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12) dgnnum, dgnstr, idgns, ickmm
       close(12)


       filename='sfceta3.'//ftag
       open(unit=12,file=filename,form='unformatted')
!
       if (nm == 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)
       end if
!
       close(12)
!
       filename='fcstdata.'//ftag
       open(unit=12,file=filename,form='unformatted')
       write(12) tprec, theat, tclod, trdsw, trdlw, tsrfc
       close(12)
      
       
!======================================================================      
!!!! DECOMPOSING MONTHLY SST (data set from December, 1981 - Jul, 2011)          DRAGAN, August, 2011
!======================================================================


      if(lvsst)then
      
      do M=416,421 
  
        write(cn,'(i4.4)') M
        
        monthlysst='/scratchout/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/initdata/monthly_sst'//cn//'.bin'
   
        open(33,file=monthlysst,form='unformatted',status='unknown',access='sequential')  
        read(33) msstt
        close(33)
       
       
        monthlysst='/scratchout/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/initdata/monthly_sst'//cn//'.'//ftag
     
        open(44,file=monthlysst,form='unformatted',status='unknown',access='sequential') 
       
        if(nm == 14) then
          call a2aloc(msstt, i1, j1, n, 1, 44)
        else
          call a2al  (msstt, i1, j1, n, 1, 44)
        end if
!        
       close(44)
    
      end do
!
      end if
!===============================================================       
!!!! DECOMPOSING MONTHLY VEG GREENESS                                             DRAGAN, August, 2011
!===============================================================
    
   
        if(lveg)then
  
         do imo=1,12 
           write(cn2,'(i2.2)') imo
!           green_mon='VGREEN_12mon'//cn2//'.bin'
           green_mon='/scratchin/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/gef_trunk/PRP/data_in/init/VGREEN_12mon'//cn2//'.bin'
	   
	   open(55,file=green_mon,form='unformatted',status='unknown',access='sequential')  
           read(55) vegfrm
           close(55)
!           green_mon='VGREEN_12mon'//cn2//'.'//ftag
           green_mon='/scratchin/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/gef_trunk/PRP/data_in/init/VGREEN_12mon'//cn2//'.'//ftag
	   open(66,file=green_mon,form='unformatted',status='unknown',access='sequential') 
           if(nm.eq.14)then
             call a2aloc(vegfrm,i1,j1,n,1,66)
           else
             call a2al(vegfrm,i1,j1,n,1,66)
           endif
         enddo
        endif
!-----------------------------------------------------------------------
        imin = imax
        mype = mype + 1
      end do
        jmin = jmax
      end do
      end do
!test
      filename='dgnsserver.dat'
      open(unit=12,file=filename,form='unformatted')
      write(12)ntstm,dgnnum,dgnstr,idgns
      close(12)
!test
      print *,'FINISH DECOMPOSITION'
!-----------------------------------------------------------------------
      end subroutine out4mpi_1
      
