SUBROUTINE VWR
!--------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpif.h"
    INCLUDE "mpp.h"
!--------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
!--------------------------------------------------------
    INTEGER :: JSTAT(MPI_STATUS_SIZE),STATUS_ARRAY(MPI_STATUS_SIZE,4)
    REAL :: VWRITE(IM,JM)
!--------------------------------------------------------
    IOUT=80
    DO 500 L=1,LM
    
        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
            DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
                VWRITE(I+MY_IS_GLB-1,J+MY_JS_GLB-1)=V(I,J,L)
            ENDDO
        ENDDO
    
        CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
    
        IF(MYPE == 0)THEN
            DO IPE=1,NPES-1
                DO J=JS_GLB_TABLE(IPE),JE_GLB_TABLE(IPE)
                    CALL MPI_RECV(VWRITE(IS_GLB_TABLE(IPE),J), &
                    ICHUNKTAB(IPE),MPI_REAL,IPE,99, &
                    MPI_COMM_COMP,ISTAT,IRECV)
                ENDDO
            ENDDO
        
        ELSE
            DO J=MY_JS_GLB,MY_JE_GLB
                CALL MPI_SEND(VWRITE(MY_IS_GLB,J),ICHUNKTAB(MYPE), &
                MPI_REAL,0,99, &
                MPI_COMM_COMP,ISEND)
            ENDDO
        ENDIF
    
        IF(MYPE == 0)THEN
            DO J=1,JM
                IENDX=IM
                IF(MOD(J,2) == 1)IENDX=IM-1
                WRITE(IOUT)(VWRITE(I,J),I=1,IENDX)
            ENDDO
        ENDIF
    500 END DO

    STOP555

    RETURN
    END SUBROUTINE VWR