#include "ESMFPIO.h"
#define __PIO_FILE__ "pionfput_mod.F90"
module pionfput_mod
  !pl  This file is input to the perl program genf90.pl which generates  
  !pl  f90 code for various datatypes and dimensions.
  !pl  Supported parser keywords are {TYPE}, {DIMS}, {VTYPE}, {DIMSTR} and {MPITYPE} 
#ifdef TIMING
  use perf_mod, only : t_startf, t_stopf      ! _EXTERNAL
#endif
  use pio_kinds, only: i4,r4,r8,pio_offset
  use pio_types, only : file_desc_t, iosystem_desc_t, var_desc_t, &
	pio_iotype_pbinary, pio_iotype_binary, pio_iotype_direct_pbinary, &
	pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4p, &
        pio_iotype_netcdf4c, pio_noerr

  use pio_utils, only : check_netcdf
  use pio_msg_mod
  use pio_support, only : Debug, DebugIO, piodie   
#ifdef _NETCDF
  use netcdf            ! _EXTERNAL
#endif
  implicit none
  private
#ifdef _PNETCDF
#include <pnetcdf.inc>  /* _EXTERNAL */
#endif
#ifdef _NETCDF
! Required for netcdf bug workaround
  integer, external :: nf_put_vars_text
#endif
  include 'mpif.h'   ! _EXTERNAL

!>
!! @defgroup PIO_put_var PIO_put_var
!! @brief Writes netcdf metadata to a file
!! @details The put_var interface is provided as a simplified interface to
!!  write variables to a netcdf format file.   
!! @warning Although this is a collective call the variable is written from the 
!!  root IO task, no consistancy check is made with data passed on other tasks.
!! 
!<
  public :: put_var
  interface put_var
     !  DIMS 0,1,2,3,4,5
     module procedure put_var_{DIMS}d_{TYPE}, put_var_vdesc_{DIMS}d_{TYPE}
     !  DIMS 1,2,3,4,5
     module procedure put_vara_{DIMS}d_{TYPE}, put_vara_vdesc_{DIMS}d_{TYPE}
     module procedure put_var1_{TYPE}, put_var1_vdesc_{TYPE}
  end interface
contains

!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf attribute to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param varid : The netcdf variable identifier
!! @param index : 
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_var1_{TYPE} (File,varid, index, ival) result(ierr)
    type (File_desc_t), intent(inout) :: File
    integer, intent(in) :: varid, index(:)
    {VTYPE}, intent(in) :: ival
    integer, allocatable :: count(:)
    integer :: iotype
    type(iosystem_desc_t), pointer :: ios
    integer :: ilen, msg, mpierr

#ifdef TIMING
    call t_startf("pio_put_var1_{TYPE}")
#endif 
    ierr=0
    iotype = File%iotype 
    if(debug) print *,__PIO_FILE__,__LINE__,ival,iotype, index

    ios=>File%iosystem
    if(ios%async_interface .and. .not. ios%ioproc ) then
       msg=PIO_MSG_PUTVAR1
       if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr)
       call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(size(index),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(index,size(index),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#if({ITYPE} == TYPETEXT) 
          ilen = len(ival)
          call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#endif
    endif

    if(ios%async_interface) then
       call MPI_BCAST(ival,1,{MPITYPE},ios%CompMaster, ios%my_comm , mpierr)
    end if



    if(Ios%IOProc) then
       allocate(count(size(index)))
       if(Ios%io_rank == 0) then
          count(:) = 1
#if ({ITYPE} == TYPETEXT)
          count(1) = len(ival)
#endif	
       else
          count(:) = 0
       end if

       select case (iotype) 
#ifdef _PNETCDF
       case(pio_iotype_pnetcdf)
          ierr = nfmpi_put_vara_all (File%fh, varid, int(index,kind=PIO_OFFSET), int(count,kind=PIO_OFFSET), &
               ival, int(count,kind=PIO_OFFSET), {MPITYPE})
#endif
#ifdef _NETCDF
       case (pio_iotype_netcdf4p)
          ierr = nf90_put_var(File%fh, varid, ival, start=index)
       case(pio_iotype_netcdf,pio_iotype_netcdf4c)
          ! Only io proc 0 will do writing
          if (Ios%io_rank == 0) then
             ierr = nf90_put_var(File%fh, varid, ival, start=index)
          end if
#endif
       case default
          print *,__PIO_FILE__,__LINE__,iotype
          call piodie(__PIO_FILE__,__LINE__,"bad iotype specified")
       end select
       deallocate(count)
    end if
    call check_netcdf(File,ierr,__PIO_FILE__,__LINE__)

#ifdef TIMING
    call t_stopf("pio_put_var1_{TYPE}")
#endif 
  end function put_var1_{TYPE}

!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf attribute to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param vardesc @copydoc var_desc_t
!! @param start : 
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_var1_vdesc_{TYPE} (File,vardesc, start, ival) result(ierr)
    type (File_desc_t), intent(inout) :: File
    type(var_desc_t), intent(in) :: vardesc
    integer, intent(in) ::  start(:)
    {VTYPE}, intent(in) :: ival

    ierr = put_var1_{TYPE} (File, vardesc%varid, start, ival)
  end function put_var1_vdesc_{TYPE}

! DIMS 0,1,2,3,4,5
!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf attribute to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param File : A file handle returne from \ref PIO_openfile or \ref PIO_createfile.
!! @param varid : The netcdf variable identifier
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_var_{DIMS}d_{TYPE} (File,varid, ival) result(ierr)
    type (File_desc_t), intent(inout) :: File
    integer, intent(in) :: varid
    {VTYPE}, intent(in) :: ival{DIMSTR}
    integer :: iotype
    integer :: i, is, msg, mpierr, ilen
    type(iosystem_desc_t), pointer :: ios
    integer :: dims({DIMS})
#if({ITYPE}== TYPETEXT)
    integer :: start({DIMS}+1), count({DIMS}+1)
#else
    integer :: start({DIMS}), count({DIMS})
#endif
#ifdef TIMING
    call t_startf("pio_put_var_{DIMS}d_{TYPE}")
#endif 
    ierr=PIO_NOERR

    iotype = File%iotype 
    start = 1
    count = 0
    is=0       


#ifdef _PNETCDF
#if(({DIMS}>0) && ({ITYPE} != TYPETEXT))
    if(iotype == pio_iotype_pnetcdf) then
       do i=1,{DIMS}
          count(i) = size(ival,i)
       end do
       ierr = put_vara_{DIMS}d_{TYPE} (File, varid, start, count, ival)
       return
    end if
#endif
#endif
    ios=>File%iosystem
    if(ios%async_interface .and. .not. ios%ioproc ) then
       msg=PIO_MSG_PUTVAR_{DIMS}d
       if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr)
       call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#if ({DIMS} > 0)
       do i=1,{DIMS}
          dims(i)=size(ival,i)
       end do
       call MPI_BCAST(dims,{DIMS},MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#endif
#if({ITYPE} == TYPETEXT) 
       ilen = len(ival)
       call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#endif
    endif

    if(ios%async_interface ) then
#if({DIMS}==0)       
       call MPI_BCAST(ival,1,{MPITYPE},ios%CompMaster, ios%my_comm , mpierr)
#else
       call MPI_BCAST(ival,size(ival),{MPITYPE},ios%CompMaster, ios%my_comm , mpierr)
#endif
    end if

    if(Ios%IOProc) then
       if(Ios%io_rank==0) then
#if({ITYPE}== TYPETEXT)
    	  count(1)=len(ival)
	  is=1
#endif
#if ({DIMS} > 0)
          do i=1,{DIMS}
             count(i+is) = size(ival,i)
          end do
#endif
       end if
       select case (iotype) 
#ifdef _PNETCDF
       case(pio_iotype_pnetcdf)
#if(({DIMS}==0) || ({ITYPE}== TYPETEXT))
          ierr = nfmpi_begin_indep_data(File%fh)
          if(Ios%io_rank==0 .and. (ierr==NF_EINDEP .or. ierr==PIO_NOERR)) then
             ierr = nfmpi_put_var_{TYPE} (File%fh, varid, ival)
          end if
          if(ierr==PIO_NOERR) then
             ierr = nfmpi_end_indep_data(File%fh)
          end if
!#else
          ! this wont work because put_vara is collective
!          ierr = put_vara_{DIMS}d_{TYPE} (File, varid, start, count, ival)
#endif
#endif
#ifdef _NETCDF
       case(pio_iotype_netcdf4p)
#if (({ITYPE} == TYPETEXT) && ({DIMS}==0))
! This is a workaround for a bug in the netcdf f90 interface
! The netcdf bug is that when you use nf90_put_var
! to write a scalar string the trailing blanks are stripped by the specific
! function nf90_put_var_text before it calls nf_put_vars_text. 
          if (Ios%io_rank == 0) then
             ierr = nf_put_vars_text(File%fh, varid, (/1/), (/len(ival)/), (/1/), ival)
          else
             ierr = nf_put_vars_text(File%fh, varid, (/1/), (/0/), (/1/), ival)
          end if
#elif({DIMS} == 0) 
          ierr = nf90_put_var(File%fh, varid, ival)
#else
          ierr = nf90_put_var(File%fh, varid, ival, start=start, count=count)
#endif
       case(pio_iotype_netcdf,pio_iotype_netcdf4c)
          ! Only io proc 0 will do writing
          if (Ios%io_rank == 0) then

#if (({ITYPE} == TYPETEXT) && ({DIMS}==0))
! This is a workaround for a bug in the netcdf f90 interface
! The netcdf bug is that when you use nf90_put_var
! to write a scalar string the trailing blanks are stripped by the specific
! function nf90_put_var_text before it calls nf_put_vars_text. 
             ierr = nf_put_vars_text(File%fh, varid, (/1/), (/len(ival)/), (/1/), ival)
#else
             ierr = nf90_put_var(File%fh, varid, ival)
#endif
          end if
#endif
       case default
          print *,__PIO_FILE__,__LINE__,iotype
          call piodie(__PIO_FILE__,__LINE__,"bad iotype specified" )

       end select
    end if

    call check_netcdf(File,ierr,__PIO_FILE__,__LINE__)
#ifdef TIMING
    call t_stopf("pio_put_var_{DIMS}d_{TYPE}")
#endif 
  end function put_var_{DIMS}d_{TYPE}

! DIMS 0,1,2,3,4,5
!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf attribute to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param vardesc @copydoc var_desc_t
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_var_vdesc_{DIMS}d_{TYPE} (File, vardesc, ival) result(ierr)
    type (File_desc_t), intent(inout) :: File
    type(var_desc_t) , intent(in) :: vardesc
    {VTYPE}, intent(in) :: ival{DIMSTR}
    integer :: iotype

    ierr = put_var_{DIMS}d_{TYPE} (File, vardesc%varid, ival)
  end function put_var_vdesc_{DIMS}d_{TYPE}

! DIMS 1,2,3,4,5
!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf attribute to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param varid : The netcdf variable identifier
!! @param start :
!! @param count :
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_vara_{DIMS}d_{TYPE} (File,varid, start, count, ival) result(ierr)
    use nf_mod, only : pio_inq_varndims
    type (File_desc_t), intent(inout) :: File
    integer, intent(in) :: varid, start(:), count(:)

    integer(kind=PIO_OFFSET), allocatable :: pstart(:), pcount(:)

    {VTYPE}, intent(in) :: ival{DIMSTR}
    integer :: iotype, i, ndims, msg, mpierr
    integer(kind=pio_offset) :: clen
    type(iosystem_desc_t), pointer :: ios
    integer :: dims({DIMS}), ilen
#ifdef TIMING
    call t_startf("pio_put_vara_{DIMS}d_{TYPE}")
#endif 
    ierr=0
    iotype = File%iotype 
    ios=>File%iosystem
    ilen=1
    if(.not. ios%async_interface .or. .not. ios%ioproc ) then
       ierr = pio_inq_varndims(File, varid, ndims)
    end if
    if(ios%async_interface .and. .not. ios%ioproc ) then
       msg=PIO_MSG_PUTVARA_{DIMS}d
       if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr)
       call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)

       call MPI_BCAST(size(start),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(start,size(start),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(count,size(start),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)

#if ({DIMS} > 0)
       do i=1,{DIMS}
          dims(i)=size(ival,i)
       end do
       call MPI_BCAST(dims,{DIMS},MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#endif
#if({ITYPE} == TYPETEXT) 
       ilen = len(ival)
       call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
#endif
    endif

    if(ios%async_interface ) then    
       call MPI_BCAST(ndims,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr)
       call MPI_BCAST(ival,ilen*size(ival),{MPITYPE},ios%CompMaster, ios%my_comm , mpierr)
    end if


    
    if(Ios%IOProc) then
       allocate(pstart(ndims),pcount(ndims))
       if(Ios%io_rank==0) then
          pstart = start(1:ndims)
          pcount = count(1:ndims)
       else
          pstart=1 ! avoids an unessasary pnetcdf error 
          pcount=0
       endif
       select case (iotype) 
#ifdef _PNETCDF
       case(pio_iotype_pnetcdf)
          clen=count(1)
          do i=2,size(count)
             clen=clen*count(i)
          end do
          ierr = nfmpi_put_vara_{TYPE}_all (File%fh, varid, pstart, &
               pcount, ival, clen, {MPITYPE})
#endif
#ifdef _NETCDF
       case(pio_iotype_netcdf4p)
          ierr = nf90_put_var(File%fh, varid, ival, start=int(pstart), count=int(pcount))
       case(pio_iotype_netcdf, pio_iotype_netcdf4c)
          ! Only io proc 0 will do writing
          if (Ios%io_rank == 0) then
             ierr = nf90_put_var(File%fh, varid, ival, start=int(pstart), count=int(pcount))
          end if
#endif
       case default
          print *,__PIO_FILE__,__LINE__,iotype
          call piodie(__PIO_FILE__,__LINE__,"bad iotype specified")
       end select
       deallocate(pstart, pcount)
    end if
    call check_netcdf(File, ierr,__PIO_FILE__,__LINE__)

#ifdef TIMING
    call t_stopf("pio_put_vara_{DIMS}d_{TYPE}")
#endif 
  end function put_vara_{DIMS}d_{TYPE}

! DIMS 1,2,3,4,5
!>
!! @public
!! @ingroup PIO_put_var
!! @brief Writes an netcdf variable to a file
!! @details
!! @param File @copydoc file_desc_t
!! @param vardesc @copydoc var_desc_t
!! @param start : 
!! @param count : 
!! @param ival : The value for the netcdf metadata
!! @retval ierr @copydoc error_return
!<
  integer function put_vara_vdesc_{DIMS}d_{TYPE} (File,vardesc, start, count, ival) result(ierr)
    type (File_desc_t), intent(inout) :: File
    type(var_desc_t), intent(in) :: vardesc
    integer, intent(in) ::  start(:), count(:)
    {VTYPE}, intent(in) :: ival{DIMSTR}

    ierr = put_vara_{DIMS}d_{TYPE} (File, vardesc%varid, start, count, ival)


  end function put_vara_vdesc_{DIMS}d_{TYPE}
end module pionfput_mod