module cpl_agcm

  use com_cpl

  public


  !--- Local flags to determine if carbon and/or river runoff fields are
  !--- passed though the coupler
  !--- These flags are set by the AGCM through the call to coupler_atm_init
  logical, save, private :: cpl_carbon = .false.
  logical, save, private :: cpl_river_runoff = .false.

  contains

      !******************************************************************
      !--- Define the list of variables received by the agcm from the coupler
      !******************************************************************
      subroutine define_atm_recv_var(verbose)

        integer :: verbose

        !--- Local
        integer :: indx
        character(32) :: tmp_var(100)

        tmp_var(:) = " "
        atm_n_recv_var = 0

        if ( atm_forcing_from_file ) then
          !--- AGCM forcing data is being read from a file in the coupler

          !--- Ground temperature
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "GT_atm"

          !--- Sea ice thickness
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "SIC_atm"

          !--- Sea ice fraction
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "SICN_atm"

        else

          !--- Ground temperature
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "GT_atm"

          !--- Sea ice thickness
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "SIC_atm"

          !--- Sea ice fraction
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "SICN_atm"

          !--- Snow thickness
          atm_n_recv_var = atm_n_recv_var + 1
          tmp_var(atm_n_recv_var) = "SNO_atm"

          if ( cpl_carbon ) then
            atm_n_recv_var = atm_n_recv_var + 1
            tmp_var(atm_n_recv_var) = "CO2flx_atm"
          endif

        endif

        if ( associated(atm_recv_var) ) deallocate(atm_recv_var)
        allocate( atm_recv_var(atm_n_recv_var) )
        do indx=1,atm_n_recv_var
          atm_recv_var(indx) = tmp_var(indx)
        enddo

        if ( verbose > 0 ) then
          write(6,*)"define_atm_recv_var: atm_n_recv_var=",atm_n_recv_var
          write(6,'(5(2x,a))')atm_recv_var(1:atm_n_recv_var)
          call flush(6)
        endif

      end subroutine define_atm_recv_var

      !******************************************************************
      !--- Define the list of variables sent by the agcm to the coupler
      !******************************************************************
      subroutine define_atm_send_var(verbose)

        integer :: verbose

        !--- Local
        integer :: indx
        character(32) :: tmp_var(100)

        tmp_var(:) = " "
        atm_n_send_var =  0

        !--- Atmosphere-Ocean wind stress (X component)
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "UFSO_atm"

        !--- Atmosphere-Ocean wind stress (Y component)
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "VFSO_atm"

        !--- Atmosphere-Ice wind stress (X component)
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "UFSI_atm"

        !--- Atmosphere-Ocean wind stress (Y component)
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "VFSI_atm"

        !--- Runoff
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "RIVO_atm"

        !--- Solar heat flux over open ocean
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "FSGO_atm"

        !--- Solar heat flux over ice
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "FSGI_atm"

        if ( cpl_carbon ) then
          !--- Mean sea level pressure
          atm_n_send_var = atm_n_send_var + 1
          tmp_var(atm_n_send_var) = "PMSL_atm"
        endif

        !--- 10 meter wind
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "SWMX_atm"

        if ( cpl_carbon ) then
          !--- Atmospheric CO2
          atm_n_send_var = atm_n_send_var + 1
          tmp_var(atm_n_send_var) = "CO2_atm"
        endif

        !--- The folowing fields are required for NEMO
        !--- but are not used by the old ocean model (CanOM4)

        !--- Total heat flux over ocean
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "BEGO_atm"

        !--- P-E over ocean
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "BWGO_atm"

        !--- Total liquid precipitation
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "RAIN_atm"

        !--- Total solid precipitation
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "SNOW_atm"

        !--- P-E over ice
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "BWGI_atm"

        !--- Total heat flux over sea ice
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "BEGI_atm"

!CICE      !--- Conductive heat flux over sea ice
!CICE      atm_n_send_var = atm_n_send_var + 1
!CICE      tmp_var(atm_n_send_var) = "HSEA_atm"

        !--- Non-solar sensitivity to temperature (dQns/dT)
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "SLIM_atm"

        !--- Surface temperature over sea ice
        atm_n_send_var = atm_n_send_var + 1
        tmp_var(atm_n_send_var) = "GTICE_atm"

        if ( associated(atm_send_var) ) deallocate(atm_send_var)
        allocate( atm_send_var(atm_n_send_var) )
        do indx=1,atm_n_send_var
          atm_send_var(indx) = tmp_var(indx)
        enddo

        if ( verbose > 0 ) then
          write(6,*)"define_atm_send_var: atm_n_send_var=",atm_n_send_var
          write(6,'(5(2x,a))')atm_send_var(1:atm_n_send_var)
          call flush(6)
        endif

      end subroutine define_atm_send_var

      !******************************************************************
      !--- Given the gaussian latitudes and weights from a call to the
      !--- subroutine gauss(), return the gaussian latitude(nlat) ordered
      !--- South to North, longitude(nlon) ordered West to East and the
      !--- gaussian weights defined at all latitudes, as well as the
      !--- dimensional grid cell areas in an (nlon,nlat) array.
      !******************************************************************
      subroutine coupler_atm_coords(lon_coord,lat_coord,gauss_wgt, &
                          cell_area,nlon,nlat,pii,earth_radius)
        implicit none

        real(kind=8), intent(inout) :: lon_coord(nlon)
        real(kind=8), intent(inout) :: lat_coord(nlat)
        real(kind=8), intent(inout) :: gauss_wgt(nlat)
        real(kind=8), intent(inout) :: cell_area(nlon,nlat)
        integer, intent(in) :: nlon, nlat
        !--- earth_radius must be in meters
        real(kind=8), intent(in) :: pii, earth_radius

        !--- Local
        integer :: idx, kdx
        real(kind=8) :: cfac

        !--- Sanity checks on input
        if ( nlat < 1 .or. nlat > 10000 ) then
          write(6,*)"coupler_atm_coords: Invalid input value of nlat = ",nlat
          call xit("coupler_atm_coords",-1)
        endif
        if ( nlon < 1 .or. nlon > 10000 ) then
          write(6,*)"coupler_atm_coords: Invalid input value of nlon = ",nlon
          call xit("coupler_atm_coords",-2)
        endif
        if ( abs(pii-3.14159) > 0.001 ) then
          write(6,*)"coupler_atm_coords: Invalid input value of pi = ",pii
          call xit("coupler_atm_coords",-3)
        endif
        if ( abs(earth_radius-6.37122e6) > 1e4 ) then
          write(6,*) &
            "coupler_atm_coords: Invalid input value of earth_radius = ", &
            earth_radius
          call xit("coupler_atm_coords",-4)
        endif
        if ( abs(1.0_8-sum(gauss_wgt)) > 0.1 ) then
          !--- The sum of the input weights should be 1.0
          write(6,*)"coupler_atm_coords: The sum of input weights is", &
            sum(gauss_wgt),"  ...this sum should be 1"
          write(6,*)"coupler_atm_coords: Gaussian weights="
          write(6,'(5g24.16)')gauss_wgt(1:nlat/2)
          call xit("coupler_atm_coords",-5)
        endif
        if ( minval(lat_coord(1:nlat/2)) < 0.0 .or. &
            maxval(lat_coord(1:nlat/2)) > 1.58 ) then
          !--- The input lat_coord values should be in the range 0-pi/2
          write(6,*)"coupler_atm_coords: Invalid input latitudes"
          write(6,*)"coupler_atm_coords: Gaussian colatitude="
          write(6,'(5g24.16)')lat_coord(1:nlat/2)
          call xit("coupler_atm_coords",-6)
        endif

        !--- Use gaussian latitudes and weights passed in via lat_coord
        !--- and gauss_wgt respectively to define the latitude and
        !--- cell area arrays that are passed out.
        !--- These input values are assumed to be output from a call to
        !--- gauss() done prior to calling this subroutine and therefore
        !--- are filled (1:nlat/2) with values of colatitude in radians
        !--- for lat_coord and gaussian weights for gauss_wgt
        !--- that are associated with the first nlat/2 positive roots of
        !--- the Legendre polynomials of degree nlat.
        !--- Convert to latitude, reorder south to north and fill in the
        !--- missing half using the symmetry of Legendre polynomials
        do idx=1,nlat/2
          kdx = nlat + 1 - idx
          lat_coord(kdx) = 0.5_8 * pii - lat_coord(idx)
          lat_coord(idx) = -lat_coord(kdx)
          gauss_wgt(kdx) = gauss_wgt(idx)
        enddo

        !--- NOTE:
        !--- The non-dimensional sum(gauss_wgt) should be 2.0 to machine precision
        !--- This will be true if gauss() was used to calculate the input data
        !--- If gaussg() is used then the input data will only be accurate to about
        !--- 13 decimal digits (ie NOT to machine precision) and the sum of the weights
        !--- in this case will be 1.99999999999998512 (at T63)

        !--- Convert weights to area in meters^2
        !--- Use values for Pi and earth radius passed in from the AGCM
        cfac = pii * earth_radius**2 / real(nlat,kind=8)
        cell_area(1,:) = cfac * gauss_wgt(:)

        !--- Broadcast the first column accross the entire area array
        do idx=2,nlon
          cell_area(idx,:) = cell_area(1,:)
        enddo

        !--- At T63 the total surface area sum is 510099699070770.125 meters**2
        !--- Estimates of the actual earth surface area are:
        !---                                      510072000 square kilometers
        !---                                      510064472 square kilometers
        !---                                      510064472 square kilometers
        !---                                      510100000 square kilometers

        !--- Define longitudes (degrees_east) of grid cell centers
        !--- Longitudes are always equally spaced on the AGCM grid
        !--- and the first grid cell center is at 0.0
        cfac = 360.0_8/real(nlon,kind=8)
        do idx=1,nlon
          lon_coord(idx) = cfac*(idx-1)
        enddo

        !--- Define latitudes (degrees_north) of grid cell centers
        !--- Convert radians to degrees
        cfac = 180.0_8/pii
        lat_coord(1:nlat) = cfac * lat_coord(1:nlat)

      end subroutine coupler_atm_coords

      !******************************************************************
      !--- Initialize atm specific coupler elements and define the list
      !--- of variables that are transfered (sent or received) between
      !--- the atm and the coupler
      !******************************************************************
      subroutine coupler_atm_init(nlon,nlat,ilat,ijpak,kstart,ksteps, &
                  kount,kfinal,delt,flndpak,earth_radius, &
                  lon_coord,lat_coord,gauss_wgt,cell_area, &
                  cpl_carbon_in, cpl_river_runoff_in)

        integer, intent(in) :: nlon,nlat,ilat,ijpak
        integer, intent(in) :: kstart,ksteps,kount,kfinal
        real,    intent(in) :: delt
        real :: flndpak(ijpak)
        real(kind=8), intent(in) :: earth_radius
        real(kind=8), intent(in) :: lon_coord(:)
        real(kind=8), intent(in) :: lat_coord(:)
        real(kind=8), intent(in) :: gauss_wgt(:)
        real(kind=8), intent(in) :: cell_area(:,:)
        logical, intent(in) :: cpl_carbon_in
        logical, intent(in) :: cpl_river_runoff_in

        !--- Local
        !--- wrks is required in the calls to MPI_PUTGGB2 but is not used
        !--- by MPI_PUTGGB2. MPI_PUTGGB2 should be modified for this and
        !--- other reasons (e.g. other input parameters are also not used)
        !--- and transfer via send_fld done in MPI_PUTGGB2 is depreciated.
        real :: wrks(1)
        real, pointer :: gll(:)

        !--- Define switches that determine if carbon and/or river runoff
        !--- fields are to be passed through the coupler
        cpl_carbon = cpl_carbon_in
        cpl_river_runoff = cpl_river_runoff_in

        !--- These variables will be broadcast to all mpi tasks
        !--- in the following call to cpl_initialize_events
        atm_kstart  = kstart
        atm_ksteps  = ksteps
        atm_kount   = kount
        atm_kfinal  = kfinal
        atm_delt    = nint(delt,8)
        atm_nlon    = nlon
        atm_nlat    = nlat
        atm_earth_radius = earth_radius

        if ( size(lon_coord) /= atm_nlon ) then
          write(6,*)"coupler_atm_init: Shape mismatch for lon_coord"
          write(6,*)"expected nx = ",atm_nlon
          write(6,*)"   found nx = ",size(lon_coord)
          call xit("coupler_atm_init",-1)
        endif

        if ( size(lat_coord) /= atm_nlat ) then
          write(6,*)"coupler_atm_init: Shape mismatch for lat_coord"
          write(6,*)"expected ny = ",atm_nlat
          write(6,*)"   found ny = ",size(lat_coord)
          call xit("coupler_atm_init",-2)
        endif

        if ( size(gauss_wgt) /= atm_nlat ) then
          write(6,*)"coupler_atm_init: Shape mismatch for gauss_wgt"
          write(6,*)"expected ny = ",atm_nlat
          write(6,*)"   found ny = ",size(gauss_wgt)
          call xit("coupler_atm_init",-3)
        endif

        if ( size(cell_area,dim=1) /= atm_nlon .or. &
            size(cell_area,dim=2) /= atm_nlat ) then
          write(6,*)"coupler_atm_init: Shape mismatch for cell area"
          write(6,*)"expected nx,ny = ",atm_nlon,atm_nlat
          write(6,*)"   found nx,ny = ", &
                   size(cell_area,dim=1),size(cell_area,dim=2)
          call xit("coupler_atm_init",-4)
        endif

        if ( associated(atm_lon) ) deallocate(atm_lon)
        allocate( atm_lon(atm_nlon) )
        atm_lon = lon_coord

        if ( associated(atm_lat) ) deallocate(atm_lat)
        allocate( atm_lat(atm_nlat) )
        atm_lat = lat_coord

        if ( associated(atm_gwt) ) deallocate(atm_gwt)
        allocate( atm_gwt(atm_nlat) )
        atm_gwt = gauss_wgt

        if ( associated(atm_grid_cell_area) ) then
          deallocate(atm_grid_cell_area)
        endif
        allocate( atm_grid_cell_area(atm_nlon,atm_nlat) )
        atm_grid_cell_area = cell_area

        !--- Define the list of fields sent and received by the atm
        !--- These lists will be broadcast to the coupler in the
        !--- following call to cpl_initialize_events
        call define_atm_send_var(0)
        call define_atm_recv_var(0)

        !--- Initialize coupler variables, broadcast atm variables
        call cpl_initialize_events()

        !--- Temporary space for the following transfer
        allocate( gll((atm_nlon+1)*ilat) )

       !--- Send the AGCM fractional land mask to the coupler
        CALL MPI_PUTGGB2(FLNDPAK,atm_nlon+1,ILAT,0,0,1,0, &
                         NC4TO8("FLND"),1,GLL,WRKS,a_flnd)

        deallocate( gll )

        !--- Broadcast the initial date and time from the coupler to all tasks
        call bcastGroup(cpl_time_string, cpl_master, MPI_COMM_WORLD)

      end subroutine coupler_atm_init

      !******************************************************************
      !--- Receive fields from the coupler
      !******************************************************************
      subroutine coupler_in ( &
      gtpal,sicpak,sicnpak,snopat_iosic,fcoopak, &
      ijpak,lon1,ilat,nlat)

      !--- Oct 10, 2018 - M.Lazare.
      !---   Unused old coupler fields, kount, CLASS/CTEM fields and "ntrac" removed.
      !--- Apr 06, 2018 - M.Lazare.
      !---   "xsfxpak" changed to "fcoopak" and "ico2" removed.
      !--- Feb 2017 - L.Solheim
      !---   Moved from updates to the current location in the coupler repo
      !---
      !--- April 22,2016 - L.Solheim
      !---   Remove all externally defined tag arrays
      !---   Complete rewrite to process atm_recv_var
      !---
      !--- July 06,2015 - M.Lazare.
      !---   Created

      implicit none

      !--- Fields sent from the ocean to the AGCM

      real, dimension (ijpak)      :: gtpal,sicpak,sicnpak, &
                                      snopat_iosic,fcoopak

      !--- Array sizes etc
      integer :: ijpak,lon1,ilat,nlat

      !--- Local
      integer k,l,m,n,nam,idx,nc4to8
      type(cpl_vinfo_t) :: curr_vinfo
      integer :: atag(3), mpitag
      !==================================================================

      !--- Send a time and date string from the coupler to the agcm
      !--- cpl_time_string is found in the com_cpl module
      call bcast_inter(cpl_time_string, cpl_master, "atm")

      !--- Send elasped coupler time in seconds from the coupler to the atm
      !--- cpl_elapsed_time_secs is found in the com_cpl module
      call bcast_inter(cpl_elapsed_time_secs, cpl_master, "atm")

      if ( atm_n_recv_var > 0 ) then
        do idx=1,atm_n_recv_var
          !--- Get information about the current variable
          curr_vinfo = find_cpl_vinfo(name=trim(adjustl(atm_recv_var(idx))))

          !--- Define the tag array used by MPI_GETCPL2
          mpitag = curr_vinfo%tag
          atag = (/ mpitag, mpitag, curr_vinfo%size /)

          select case ( trim(adjustl(atm_recv_var(idx))) )
            case ("GT_atm")
              !--- Ground temperature
              CALL MPI_GETCPL2(GTPAL, LON1, NLAT, 1, atag)

            case ("SIC_atm")
              !--- Sea ice thickness (IWE)
              CALL MPI_GETCPL2(SICPAK, LON1, NLAT, 1, atag)

            case ("SICN_atm")
              !--- Sea ice fraction
              CALL MPI_GETCPL2(SICNPAK, LON1, NLAT, 1, atag)

            case ("SNO_atm")
              !--- Snow mass per unit area over the sea ice fraction of the grid cell
              CALL MPI_GETCPL2(snopat_iosic, LON1, NLAT, 1, atag)

            case ("CO2flx_atm")
              !--- CO2 flux from the ocean
              CALL MPI_GETCPL2(FCOOPAK, LON1,NLAT,1,atag)

            case default
              write(6,'(2a)')'coupler_in: Unknown variable name ', &
                           trim(atm_recv_var(idx))
              call xit("coupler_in",-1)

          end select
        enddo

      else
        write(6,'(a)')'coupler_in: atm_n_recv_var == 0'
        call xit("coupler_in",-1)
      endif

      end subroutine coupler_in

      !******************************************************************
      !--- Send fields from the AGCM to the ocean via the coupler
      !******************************************************************
      subroutine coupler_out ( &
      ufspal,vfspal,ufsopal,vfsopal,ufsipal,vfsipal, &
      rofopal,rivogrd, &
      gtpal,sicpak,sicnpak,snopako,ofsgpal,fsgopal,fsgipal, &
      pmslpal,swapal,xsrfpal,slimpal, &
      SLIMPlw,SLIMPsh,SLIMPlh,GTPAX, &
      hseapal,begopal,begipal,rainspal,snowspal,bwgopal,bwgipal, &
      ntrac,ijpak,lon1,ilat,nlat,mynode, &
      luia,khem,npgg,k,ngll,ico2 &
      )

      !--- Oct 10, 2018 - M.Lazare.
      !---   Unused old coupler fields and CLASS/CTEM fields removed.
      !--- Feb 2017 - L.Solheim
      !---   Moved from updates to the current location in the coupler repo
      !--- April 22,2016 - L.Solheim
      !---   Remove all externally defined tag arrays
      !---   Complete rewrite to process atm_send_var
      !--- July 06,2015 - M.Lazare.
      !---   Created

      implicit none

      !--- Fields sent from the AGCM to the ocean

      !--- Tiled components of wind stress
      real, dimension (ijpak) :: ufsopal,vfsopal,ufsipal,vfsipal

      real, dimension (ijpak,ntrac):: xsrfpal
      real, dimension (ijpak)      :: ufspal,vfspal, &
                                      rofopal,pmslpal,swapal
      real, dimension (ijpak)      :: gtpal,sicpak,sicnpak, &
                                      snopako,ofsgpal,fsgopal,fsgipal, &
                                      hseapal,begopal,begipal,slimpal, &
                                      rainspal,snowspal,bwgopal,bwgipal
      real, dimension (ijpak)      :: SLIMPlw,SLIMPsh,SLIMPlh
      real, dimension (ijpak)      :: GTPAX
      real, dimension(lon1,nlat)   :: RIVOGRD

      !--- Array sizes etc
      integer   :: ntrac,ijpak,lon1,ilat,nlat
      integer   :: luia,khem,npgg,k,ngll,ico2
      integer*4 :: mynode

      !--- Local

      !--- wrks is required in the calls to MPI_PUTGGB2 but is not used
      !--- by MPI_PUTGGB2
      real :: wrks(1)
      real, pointer :: gll(:)

      integer :: l, m, n, nam, idx, nc4to8

      type(cpl_vinfo_t) :: curr_vinfo
      integer :: atag(3), mpitag
      !==================================================================

      !--- Temporary space for the following transfers
      allocate( gll(lon1*nlat) )

      if ( atm_n_send_var > 0 ) then

        do idx=1,atm_n_send_var
          !--- Get information about the current variable
          curr_vinfo = find_cpl_vinfo(name=trim(adjustl(atm_send_var(idx))))

          !--- Define the tag array used by MPI_PUTGGB2
          mpitag = curr_vinfo%tag
          atag = (/ mpitag, mpitag, curr_vinfo%size /)

          select case ( trim(adjustl(atm_send_var(idx))) )
            case ("OUFS_atm")
              !--- Mixed atmosphere-Ocean wind stress (X component)
              CALL MPI_PUTGGB2(UFSPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("OUFS"),1,GLL,WRKS,atag)
              UFSPAL = 0.0

            case ("OVFS_atm")
              !--- Mixed atmosphere-Ocean wind stress (Y component)
              CALL MPI_PUTGGB2(VFSPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("OVFS"),1,GLL,WRKS,atag)
              VFSPAL = 0.0

            case ("UFSO_atm")
              !--- Atmosphere-Ocean wind stress over ocean (X component)
              !--- Tiled ocean value
              CALL MPI_PUTGGB2(ufsopal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("UFSO"),1,GLL,WRKS,atag)
              ufsopal = 0.0

            case ("VFSO_atm")
              !--- Atmosphere-Ocean wind stress over ocean (Y component)
              !--- Tiled ocean value
              CALL MPI_PUTGGB2(vfsopal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("VFSO"),1,GLL,WRKS,atag)
              vfsopal = 0.0

            case ("UFSI_atm")
              !--- Atmosphere-Ice wind stress over ice (X component)
              !--- Tiled ice value
              CALL MPI_PUTGGB2(ufsipal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("UFSI"),1,GLL,WRKS,atag)
              ufsipal = 0.0

            case ("VFSI_atm")
              !--- Atmosphere-Ice wind stress over ice (Y component)
              !--- Tiled ice value
              CALL MPI_PUTGGB2(vfsipal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("VFSI"),1,GLL,WRKS,atag)
              vfsipal = 0.0

            case ("ROFO_atm")
              !--- Runoff over land
              CALL MPI_PUTGGB2(ROFOPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("ROFO"),1,GLL,WRKS,atag)
              ROFOPAL = 0.0

            case ("RIVO_atm")
              !--- River runoff over land
              if ( .not. cpl_river_runoff ) then
                RIVOGRD = 0.0
              endif
              if ( mynode == atm_master ) then
                !--- This field is only defined on the AGCM master task so
                !--- it does not require a gather prior to transmission
                call send_data_rec(rivogrd, cpl_master, "RIVO_atm")
                RIVOGRD = 0.0
              endif

            case ("GT_atm")
              !--- Ground temperature
              CALL MPI_PUTGGB2(GTPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("  GT"),1,GLL,WRKS,atag)

            case ("GTICE_atm")
              !--- Sea ice temperature
              CALL MPI_PUTGGB2(GTPAX,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8(" GTI"),1,GLL,WRKS,atag)

            case ("SIC_atm")
              !--- Sea ice thickness (IWE)
              CALL MPI_PUTGGB2(SICPAK,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8(" SIC"),1,GLL,WRKS,atag)

            case ("SICN_atm")
              !--- Sea ice fraction
              CALL MPI_PUTGGB2(SICNPAK,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SICN"),1,GLL,WRKS,atag)

            case ("SNO_atm")
              !--- Snow thickness (SWE)
              CALL MPI_PUTGGB2(SNOPAKO,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8(" SNO"),1,GLL,WRKS,atag)

            case ("OFSG_atm")
              !--- Mixed solar heat flux over ocean and ice
              CALL MPI_PUTGGB2(OFSGPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("OFSG"),1,GLL,WRKS,atag)
              OFSGPAL = 0.0

            case ("FSGO_atm")
              !--- Solar heat flux over ocean
              CALL MPI_PUTGGB2(fsgopal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("FSGO"),1,GLL,WRKS,atag)
              fsgopal = 0.0

            case ("FSGI_atm")
              !--- Solar heat flux over ice
              CALL MPI_PUTGGB2(fsgipal,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("FSGI"),1,GLL,WRKS,atag)
              fsgipal = 0.0

            case ("SWMX_atm")
              !--- 10 meter wind
              CALL MPI_PUTGGB2(SWAPAL ,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SWMX"),1,GLL,WRKS,atag)
              SWAPAL = 0.0

            case ("BEGO_atm")
              !--- Total heat flux over ocean
              CALL MPI_PUTGGB2(BEGOPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("BEGO"),1,GLL,WRKS,atag)
              BEGOPAL = 0.0

            case ("BWGO_atm")
              !--- P-E over ocean
              CALL MPI_PUTGGB2(BWGOPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("BWGO"),1,GLL,WRKS,atag)
              BWGOPAL = 0.0

            case ("RAIN_atm")
              !--- Total liquid precipitation
              CALL MPI_PUTGGB2(RAINSPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("RAIN"),1,GLL,WRKS,atag)
              RAINSPAL = 0.0

            case ("SNOW_atm")
              !--- Total solid precipitation
              CALL MPI_PUTGGB2(SNOWSPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SNOW"),1,GLL,WRKS,atag)
              SNOWSPAL = 0.0

            case ("BWGI_atm")
              !--- P-E over sea ice
              CALL MPI_PUTGGB2(BWGIPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("BWGI"),1,GLL,WRKS,atag)
              BWGIPAL = 0.0

            case ("BEGI_atm")
              !--- Total heat flux over sea ice
              CALL MPI_PUTGGB2(BEGIPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("BEGI"),1,GLL,WRKS,atag)
              BEGIPAL = 0.0

            case ("HSEA_atm")
              !--- Conductive heat flux over sea ice
              CALL MPI_PUTGGB2(HSEAPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("HSEA"),1,GLL,WRKS,atag)
              HSEAPAL = 0.0

            case ("SLIM_atm")
              !--- Non-solar sensitivity to temperature (dQns/dT)
              CALL MPI_PUTGGB2(SLIMPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SLIM"),1,GLL,WRKS,atag)
              SLIMPAL = 0.0

            case ("SLIMlw_atm")
              !--- Term of Non-solar sensitivity to temperature (dQns/dT)
              CALL MPI_PUTGGB2(SLIMPlw,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SLIM"),1,GLL,WRKS,atag)
              SLIMPlw = 0.0

            case ("SLIMsh_atm")
              !--- Term of Non-solar sensitivity to temperature (dQns/dT)
              CALL MPI_PUTGGB2(SLIMPsh,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SLIM"),1,GLL,WRKS,atag)
              SLIMPsh = 0.0

            case ("SLIMlh_atm")
              !--- Term of Non-solar sensitivity to temperature (dQns/dT)
              CALL MPI_PUTGGB2(SLIMPlh,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("SLIM"),1,GLL,WRKS,atag)
              SLIMPlh = 0.0

            case ("PMSL_atm")
              !--- Mean sea level pressure
              CALL MPI_PUTGGB2(PMSLPAL,LON1,ILAT,KHEM,NPGG,K,LUIA, &
                              NC4TO8("PMSL"),1,GLL,WRKS,atag)
              PMSLPAL = 0.0

            case ("CO2_atm")
              !--- Atmospheric CO2
              CALL NAME2(NAM,'XL',ICO2)
              CALL MPI_PUTGGB2(XSRFPAL(1,ICO2),LON1,ILAT,KHEM,NPGG, &
                              K,LUIA,NAM,1,GLL,WRKS,atag)
              XSRFPAL = 0.0

            case default
              write(6,'(2a)')'coupler_out: Unknown variable name ', &
                           trim(atm_send_var(idx))
              call xit("coupler_out",-1)

          end select
        enddo

      else
        write(6,'(a)')'coupler_out: atm_n_send_var == 0'
        call xit("coupler_out",-1)
      endif

      !--- Always zero every input field in the following list before return
      ufspal   = 0.0
      vfspal   = 0.0
      ufsopal  = 0.0
      vfsopal  = 0.0
      ufsipal  = 0.0
      vfsipal  = 0.0
      rofopal  = 0.0
      ofsgpal  = 0.0
      fsgopal  = 0.0
      fsgipal  = 0.0
      gtpax    = 0.0
      pmslpal  = 0.0
      swapal   = 0.0
      xsrfpal  = 0.0
      slimpal  = 0.0
      SLIMPlw  = 0.0
      SLIMPsh  = 0.0
      SLIMPlh  = 0.0
      hseapal  = 0.0
      begopal  = 0.0
      begipal  = 0.0
      rainspal = 0.0
      snowspal = 0.0
      bwgopal  = 0.0
      bwgipal  = 0.0

        !--- Clean up
        deallocate( gll )

      end subroutine coupler_out

end module cpl_agcm
