!<CONTACT EMAIL="petri@pik-potsdam.de"> Stefan Petri
!</CONTACT>
!<REVIEWER EMAIL="">
!
!</REVIEWER>
!-----------------------------------------------------------------------
!<OVERVIEW>
!  Fortran-to-python wrapper for the atmospheric model Aeolus2
!</OVERVIEW>

!<DESCRIPTION>
!  Fortran-to-python wrapper for the atmospheric model Aeolus2
!  Since it was not feasible to get the python interpreter running
!  compiled and linked into the FMS/Fortran executable, we now
!  start it as separate executable via MPI_Comm_spawn,
!  and communicate with that via quasi-remote-procedure calls,
!  i.e. all Fortran variables/arrays are packed into MPI
!  messages and sent to the Python side, where they are unpacked into
!  Python variables resp. numpy arrays. And vice vers. Sigh.
!</DESCRIPTION>

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!                                                                   !!
!!                   GNU General Public License                      !!
!!                                                                   !!
!! This file is part of the Flexible Modeling System (FMS).          !!
!!                                                                   !!
!! FMS is free software; you can redistribute it and/or modify       !!
!! it and are expected to follow the terms of the GNU General Public !!
!! License as published by the Free Software Foundation.             !!
!!                                                                   !!
!! FMS is distributed in the hope that it will be useful,            !!
!! but WITHOUT ANY WARRANTY; without even the implied warranty of    !!
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     !!
!! GNU General Public License for more details.                      !!
!!                                                                   !!
!! You should have received a copy of the GNU General Public License !!
!! along with FMS; if not, write to:                                 !!
!!          Free Software Foundation, Inc.                           !!
!!          59 Temple Place, Suite 330                               !!
!!          Boston, MA  02111-1307  USA                              !!
!! or see:                                                           !!
!!          http://www.gnu.org/licenses/gpl.txt                      !!
!!                                                                   !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

#include <fms_platform.h>

module aeolus2fms_mod

#ifndef use_libMPI
  Error: Cannot compile with -DMPMD_ATMOS but without -Duse_libMPI
#endif

  use mpi ! , only: ....
  use ifport, only: getpid
  use tracer_manager_mod, only: NO_TRACER

  implicit none
  private

  public aeolus2fms_interface_check
  public aeolus2fms_init_grid, aeolus2fms_get_axes_coords, aeolus2fms_init
  public aeolus2fms_atmosphere_down, aeolus2fms_atmosphere_up
  public aeolus2fms_finish, aeolus2fms_restart
  !public aeolus2fms_get_boundary
  public aeolus2fms_get_bottom_mass, aeolus2fms_get_bottom_wind, aeolus2fms_get_stock_pe

#ifdef MPMD_ATMOS
  public setup_mpmd_comm
#endif

  !include "mpif.h"

  integer :: nlons_global, nlats_global
  logical :: lon_0_360
  ! Communicator between FMS atm tasks, created by FMS mpp.
  integer :: atmos_comm
  ! Communicator for all FMS tasks.
  ! Spawn case: MPI_COMM_WORLD; MPMD case: created by setup_mpmd_comm()
  integer :: fms_comm = MPI_COMM_WORLD
  ! Communicator between FMS atm tasks and python peer tasks.
  ! Spawn case: created by Spawn; MPMD case: MPI_COMM_WORLD
  integer :: inter_comm
#ifdef MPMD_ATMOS
  integer :: world_npes, mpmd_fms_npes = 0, mpmd_other_npes = 0
#endif
  integer :: pe, root_pe, atm_npes
  ! Spawn case: same as pe; MPMD case: mpmd_fms_pes+pe
  integer :: peer_pe
  integer :: is, ie, js, je  ! local domain boundary indices

  integer :: nr_tracers = 0      ! total number of tracers in surf_diff_type fields
  integer :: q_ind = NO_TRACER   ! index of humidity in tracers array
  integer :: co2_ind = NO_TRACER ! index of CO2 in tracers array

contains

#ifdef MPMD_ATMOS
  subroutine setup_mpmd_comm(fms_comm_out)
    integer, intent(out) :: fms_comm_out

    character(len=8) :: envvar
    integer :: len
    integer :: group_world, group_fms
    integer :: ranks(3,1)
    integer :: ierror

    write(*,*) 'setup_mpmd_comm calling MPI_Init()'
    call flush(6)
    call MPI_Init(ierror)
    fms_comm_out = MPI_COMM_WORLD
    call MPI_Comm_rank(MPI_COMM_WORLD, pe, ierror)
    call MPI_Comm_size(MPI_COMM_WORLD, world_npes, ierror)

    call get_environment_variable('MPMD_FMS', envvar, len)
    write(*,*) 'MPMD_FMS ',envvar
    if (len > 0) read(envvar,*) mpmd_fms_npes
    write(*,*) '   as int ',mpmd_fms_npes
    call get_environment_variable('MPMD_OTHER', envvar, len)
    write(*,*) 'MPMD_OTHER ',envvar
    if (len > 0) read(envvar,*) mpmd_other_npes
    write(*,*) '   as int ',mpmd_other_npes
    if (mpmd_other_npes > 0) then
       ! all FMS/Fortran tasks belong to comm_fms
       if (pe >= mpmd_fms_npes) then
          write(*,*) 'Fatal: my pe >= MPMD_FMS', pe, mpmd_fms_npes
          call flush(6)
          stop
       end if
       if (world_npes /= mpmd_fms_npes + mpmd_other_npes) then
          write(*,*) 'Fatal: world_npes /= mpmd_fms_npes + mpmd_other_npes', &
               world_npes, mpmd_fms_npes, mpmd_other_npes
          call flush(6)
          stop
       end if
       call MPI_Comm_group(MPI_COMM_WORLD, group_world, ierror)
       ranks(1,1) = 0; ranks(2,1) = mpmd_fms_npes-1; ranks(3,1) = 1;
       call MPI_Group_range_incl(group_world, 1, ranks, group_fms, ierror)
       write(*,*) 'MPI_Group_range_incl got ierror',ierror
       call MPI_Comm_create(MPI_COMM_WORLD, group_fms, fms_comm, ierror)
       write(*,*) 'MPI_Comm_create got ierror',ierror
    end if
    fms_comm_out = fms_comm
    return
  end subroutine setup_mpmd_comm
#endif


  subroutine aeolus2fms_interface_check(atmos_comm_in)
    integer, intent(in) :: atmos_comm_in

    character(len=MPI_MAX_LIBRARY_VERSION_STRING) :: mpi_version_string

    ! some magical values for testing the interface between Fortran90 and python code.
    ! we pass them from Fortran90 to python functions and test in there if they were
    ! received correctly.
    integer, parameter :: deadbeef = X'eadbeef' ! X'deadbeef' yields overflow error on 32bit machines
    integer, parameter :: fse = 4711
    real,    parameter :: onetwothree = 1234567809.0987654321D0, &
         pitest = 3.1415926535897932384626433832795029D0 ! from linux <math.h>
    logical :: true = .true., false = .false., flag
    integer :: kind_i = KIND(deadbeef), kind_r = KIND(pitest), kind_l = KIND(true)
    real, dimension(2,3) :: testarray2d
    real, dimension(2,3) :: response2d ! to store the data that was sent back from the python side
    !real, dimension(2,3,4) :: testarray3d

    integer :: i, j, k, ierror
    integer :: inter_comm_size, universe_size = -1, remote_size = -1
    integer :: mypid
    character(len=25) :: command, argv(5)
    integer, dimension(:), allocatable :: remotepids
    integer :: status(MPI_STATUS_SIZE)
    real :: zef ! space to receive 08.15

#ifdef I_MPI_VERSION
#ifdef MPICH_VERSION
    write (*,*) 'compiled with I_MPI_VERSION', I_MPI_VERSION, 'and MPICH_VERSION', MPICH_VERSION
#else
    write (*,*) 'compiled with I_MPI_VERSION', I_MPI_VERSION
#endif
#else
#ifdef MPICH_VERSION
    write (*,*) 'compiled with MPICH_VERSION', MPICH_VERSION
#endif
#endif

    call MPI_Get_library_version(mpi_version_string, i, ierror)
    write (*,*) 'running on library version ', trim(mpi_version_string)

    atmos_comm = atmos_comm_in
    call MPI_Comm_rank(atmos_comm, pe, ierror)
    call MPI_Comm_size(atmos_comm, atm_npes, ierror)
    mypid = getpid()

    ! Aarrggh. When started via slurm MPMD mode, get_attr(UNIVERSE_SIZE) yields segfault
    !call MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, universe_size, flag);
    !if (.not. flag) write(*,*) 'This MPI does not support UNIVERSE_SIZE.'
    write(*,*) 'pid', mypid, 'atm task', pe, 'of', atm_npes, 'in a universe of size', universe_size

#ifdef MPMD_ATMOS
    call MPI_Comm_size(MPI_COMM_WORLD, i, ierror)
    if (atm_npes /= mpmd_other_npes) then
       write(*,*) 'Error: atm_npes /= mpmd_other_npes', atm_npes, mpmd_other_npes
    end if
    inter_comm = MPI_COMM_WORLD
    peer_pe = mpmd_fms_npes + pe
    remote_size = atm_npes
    write (*,*) 'pid',mypid,'task',pe,'peer task',peer_pe,'of MPMD world size',i
#else
    ! Now spawn the python-implemented atmos model
    command = 'python3'
    argv(1) = '-u'
    argv(2) = '-m'
    argv(3) = 'mpi4py'
    argv(4) = 'aeolus2fms.py'
    argv(5) = ' '
    call MPI_Comm_spawn(command, argv, atm_npes, MPI_INFO_NULL, 0, atmos_comm, inter_comm, MPI_ERRCODES_IGNORE, ierror)
    call MPI_Comm_size(inter_comm, inter_comm_size, ierror)
    call MPI_Comm_rank(inter_comm, peer_pe, ierror)
    call MPI_Comm_remote_size(inter_comm, remote_size, ierror)
    write (*,*) 'pid',mypid,'task',pe,'is task',peer_pe,'of remotesize',remote_size,'in inter_comm'
    !call MPI_Barrier(inter_comm, ierror)
    ! let python code print its hello message
    !call MPI_Barrier(inter_comm, ierror)
#endif

    allocate(remotepids(remote_size))
    do i = 1,remote_size
       call MPI_Recv(remotepids(i), 1, MPI_INT, MPI_ANY_SOURCE, 42, inter_comm, status, ierror)
       write (*,*) 'F90 task',pe,'received pid',remotepids(i),'from task',status(MPI_SOURCE)
    end do
    !call MPI_Barrier(inter_comm, ierror)
    if (mpmd_other_npes > 0) then; j = mpmd_fms_npes; else; j = 0; end if
    do i = 1,remote_size
       write(*,*) 'F90 task',pe,'sending mypid to task', j
       call MPI_Send(mypid, 1, MPI_INT, j, 43, inter_comm, ierror)
       j = j+1
    end do

    ! Sigh. In the MPMD case, inter_comm is MPI_COMM_WORLD which includes ocn tasks.
    ! But those wont participate in the barrier.
    ! Workaround: dont do barrier here.
    ! Real solution: create a Communicator which excludes ocn tasks.
    ! But that requires sync with python code.
    !write(*,*) 'aeolus2fms_interface_check entering first barrier' ; call flush(6)
    !call MPI_Barrier(inter_comm, ierror)

    ! now call out into the python - implemented heart of Aeolus2
    ! first assemble some parameters with well-known values to verify
    ! that the F90<->python interface is OK.
    do j=1,3
       do i=1,2
          testarray2d(i,j) = i+j/10.0
          write (*,*) i,j,testarray2d(i,j)
       end do
    end do
    !do k=1,4
    !   do j=1,3
    !      do i=1,2
    !         testarray3d(i,j,k) = i*100.0+j+k/10.0
    !         write (*,*) i,j,k,testarray3d(i,j,k)
    !      end do
    !   end do
    !end do

    write(*,*) 'MAXEXPONENT ', MAXEXPONENT(pitest) ; call flush(6)

    write(*,*) 'aeolus2fms_interface_check sending deadbeef' ; call flush(6)
    call MPI_Send(deadbeef, 1, MPI_INT, peer_pe, 44, inter_comm, ierror)
    write(*,*) 'aeolus2fms_interface_check sending pitest' ; call flush(6)
    call MPI_Send(pitest, 1, MPI_DOUBLE, peer_pe, 45, inter_comm, ierror)
    !ierror = pyargs%setitem(3, true); errcheck
    !ierror = pyargs%setitem(4, false); errcheck
    write(*,*) 'aeolus2fms_interface_check sending testarray2d' ; call flush(6)
    call MPI_Send(testarray2d, size(testarray2d), MPI_DOUBLE, peer_pe, 46, inter_comm, ierror)
    !call MPI_Send(testarray3d, size(testarray3d), MPI_DOUBLE, peer_pe, 46, inter_comm, ierror)
    !ierror = pyargs%setitem(6, kind_i); errcheck
    !ierror = pyargs%setitem(7, kind_r); errcheck
    !ierror = pyargs%setitem(8, kind_l); errcheck
    !
    !ierror = call_py_noret(aeolus2py, "interface_check", pyargs)
    !errcheck

    write(*,*) 'aeolus2fms_interface_check receiving one double' ; call flush(6)
    call MPI_Recv(zef, 1, MPI_DOUBLE, MPI_ANY_SOURCE, 47, inter_comm, status, ierror)
    if (8.15 /= zef) then
       write(*,*) 'aeolus2fms_interface_check expected 8.15, received', zef; call flush(6)
    end if
    call MPI_Recv(response2d, size(response2d), MPI_DOUBLE, MPI_ANY_SOURCE, 48, inter_comm, status, ierror)
    if (any(testarray2d /= response2d)) then
       write(*,*) 'aeolus2fms_interface_check response2d does not match testarray2d' ; call flush(6)
       do j=1,3
          do i=1,2
             write (*,*) i,j,testarray2d(i,j),response2d(i,j)
          end do
       end do
    end if

    deallocate(remotepids)

    !write(*,*) 'aeolus2fms_interface_check entering final barrier' ; call flush(6)
    !call MPI_Barrier(inter_comm, ierror)
    write(*,*) 'aeolus2fms_interface_check finished' ; call flush(6)
  end subroutine aeolus2fms_interface_check


  subroutine aeolus2fms_init_grid(    &
         NoNx, NoNy,       &
         !NoNz, NoNz_Strato, &
         lon_0_360_in,        &
         atmos_comm_in, pe_in, root_pe_in, atm_npes_in, &
         is_in, ie_in, js_in, je_in   &
         )
    integer, intent(in) :: NoNx, NoNy
    logical, intent(in) :: lon_0_360_in
    integer, intent(in) :: atmos_comm_in, pe_in, root_pe_in, atm_npes_in
    integer, intent(in) :: is_in, ie_in, js_in, je_in
    integer :: ierror
    integer, dimension(7) :: gridparams

    nlons_global = NoNx; nlats_global = NoNy
    lon_0_360 = lon_0_360_in
    atmos_comm = atmos_comm_in; pe = pe_in; root_pe = root_pe_in; atm_npes = atm_npes_in
    is = is_in; ie = ie_in; js = js_in; je = je_in

    ! check on python side:
    ! - domain partitions and boundary indices
    gridparams(1) = nlons_global
    gridparams(2) = nlats_global
    gridparams(3) = lon_0_360
    gridparams(4) = is
    gridparams(5) = ie
    gridparams(6) = js
    gridparams(7) = je
    call MPI_Send(gridparams, size(gridparams), MPI_INT, peer_pe, 50, inter_comm, ierror)
    !write (*,*) 'aeolus2fms_init_grid sent grid params' ; call flush(6)
    write (*,*) 'aeolus2fms_init_grid finished' ; call flush(6)
  end subroutine aeolus2fms_init_grid


  subroutine aeolus2fms_get_axes_coords(lons, lonb, lats, latb) !, level, levelb, NoNx, NoNy, NoNz+NoNz_Strato)
    real, dimension(:), intent(out) :: lons, lonb, lats, latb
    integer :: status(MPI_STATUS_SIZE)
    integer :: ierror
    ! Receive the _global_ lons, lonb, lats, latb arrays for setup of diag axes
    write(*,*) 'expected global array sizes', size(lons), size(lonb), size(lats), size(latb)
    write(*,*) 'aeolus2fms_get_axes_coords receiving axes values' ; call flush(6)
    call MPI_Recv(lons, size(lons), MPI_DOUBLE, MPI_ANY_SOURCE, 51, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_axes_coords received lons' ; call flush(6)
    call MPI_Recv(lonb, size(lonb), MPI_DOUBLE, MPI_ANY_SOURCE, 52, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_axes_coords received lonb' ; call flush(6)
    call MPI_Recv(lats, size(lats), MPI_DOUBLE, MPI_ANY_SOURCE, 53, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_axes_coords received lats' ; call flush(6)
    call MPI_Recv(latb, size(latb), MPI_DOUBLE, MPI_ANY_SOURCE, 54, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_axes_coords received latb' ; call flush(6)
  end subroutine aeolus2fms_get_axes_coords


  subroutine aeolus2fms_init(    &
         Time_init_year, Time_init_month, Time_init_day, Time_init_seconds, &
         Time_days, Time_seconds,           &
         Time_step_days, Time_step_seconds, &
         without_topo,     &
         HORO,             &
         SIGORO,           &
         land_frac,        & ! the actual land_frac is only passed in the downward sweep
         area,             &
         update_land_frac_always, &
         nr_tracers_in,    &
         q_ind_in,         &
         co2_ind_in        &
         )
    integer, intent(in) :: &
         Time_init_year, Time_init_month, Time_init_day, Time_init_seconds, &
         Time_days, Time_seconds, &
         Time_step_days, Time_step_seconds
    logical, intent(in) :: without_topo
    real, dimension(:,:), intent(in) :: &
         HORO,    & ! Orography height, averaged over grid cell
         SIGORO,  & ! standard deviation of topography on local domain
         land_frac,&! provisional land fraction mask. The real one is ...
         area       ! grid cell area

    logical, intent(in) :: update_land_frac_always
    integer, intent(in) :: nr_tracers_in, q_ind_in, co2_ind_in

    integer :: ierror
    integer, dimension(14) :: aeolus2params

    nr_tracers = nr_tracers_in
    q_ind = q_ind_in
    co2_ind = co2_ind_in

    aeolus2params(1) = Time_init_year
    aeolus2params(2) = Time_init_month
    aeolus2params(3) = Time_init_day
    aeolus2params(4) = Time_init_seconds
    aeolus2params(5) = Time_days
    aeolus2params(6) = Time_seconds
    aeolus2params(7) = Time_step_days
    aeolus2params(8) = Time_step_seconds
    aeolus2params(9) = without_topo
    aeolus2params(10) = update_land_frac_always
    aeolus2params(11) = nr_tracers
    aeolus2params(12) = q_ind
    aeolus2params(13) = co2_ind
    aeolus2params(14) = 42 ! minimal interface check
    call MPI_Send(aeolus2params, size(aeolus2params), MPI_INT, peer_pe, 60, inter_comm, ierror)
    write(*,*) 'aeolus2fms_init sent params' ; call flush(6)

    if (.not.without_topo) then
       call MPI_Send(HORO, size(HORO), MPI_DOUBLE, peer_pe, 61, inter_comm, ierror)
       write(*,*) 'aeolus2fms_init sent HORO' ; call flush(6)
       call MPI_Send(SIGORO, size(SIGORO), MPI_DOUBLE, peer_pe, 62, inter_comm, ierror)
       write(*,*) 'aeolus2fms_init sent SIGHORO' ; call flush(6)
    end if
    call MPI_Send(land_frac, size(land_frac), MPI_DOUBLE, peer_pe, 63, inter_comm, ierror)
    write(*,*) 'aeolus2fms_init sent land_frac' ; call flush(6)
    call MPI_Send(area, size(area), MPI_DOUBLE, peer_pe, 64, inter_comm, ierror)
    write(*,*) 'aeolus2fms_init sent area' ; call flush(6)

    write (*,*) 'aeolus2fms_init finished' ; call flush(6)
  end subroutine aeolus2fms_init


  subroutine aeolus2fms_atmosphere_down (     &
         ! input parameters                &
         Time_seconds, Time_days,          &
         dayoftheyear,                     &
         frac_land, t_surf,  albedo,       &
         albedo_vis_dir, albedo_nir_dir,   &
         albedo_vis_dif, albedo_nir_dif,   &
         rough_mom,                        &
         u_star,  b_star, q_star,          &
         !frac_open_sea,                   & ! non-seaice fraction (%)
         dtau_du, dtau_dv,                 & ! derivatives of wind stress w.r.t. the lowest level wind speed
         ! inout parameters                &
         u_flux, v_flux,                   & ! wind stress
         ! output parameters               &
         gust,                             &
         ! coszen, cosz, solar are now input-parameters for Aeolus2
         coszen,                           &
         !coszen_radwt,                    &
         solar,                            & ! here pass the 1-D variables.
         flux_lw_sf_up,                    & 
         ! output parameters               &
         flux_sw,                          &
         flux_sw_dir, flux_sw_dif,         &
         flux_sw_down_vis_dir,             &
         flux_sw_down_vis_dif,             &
         flux_sw_down_total_dir,           &
         flux_sw_down_total_dif,           &
         flux_sw_vis,                      &
         flux_sw_vis_dir,                  &
         flux_sw_vis_dif,                  &
         flux_lw,                          &
         ! output parameters from surf_diff_type fields &
         delta_tr,               &
         dflux_tr,               &
         delta_t,                &
         dflux_t,                &
         dtmass,                 &
         delta_u,                &
         delta_v                 &
         )
    integer, intent(in) :: Time_seconds, Time_days
    integer, intent(in) :: dayoftheyear
    real, intent(in),     dimension(is:ie,js:je) :: frac_land, t_surf, albedo
    real, intent(in),     dimension(is:ie,js:je) :: albedo_vis_dir, albedo_nir_dir
    real, intent(in),     dimension(is:ie,js:je) :: albedo_vis_dif, albedo_nir_dif
    real, intent(in),     dimension(is:ie,js:je) :: rough_mom
    real, intent(in),     dimension(is:ie,js:je) :: u_star, b_star, q_star, dtau_du, dtau_dv
    !real, intent(in),     dimension(is:ie,js:je) :: frac_open_sea
    real, intent(inout),  dimension(is:ie,js:je) :: u_flux, v_flux
    real, intent(out),    dimension(is:ie,js:je) :: gust
    real, intent(in),     dimension(is:ie,js:je) :: coszen !, coszen_radwt
    real, intent(in),     dimension(js:je)       :: solar
    real, intent(in),     dimension(is:ie,js:je) :: flux_lw_sf_up
    real, intent(out),    dimension(is:ie,js:je) :: flux_sw
    real, intent(out),    dimension(is:ie,js:je) :: flux_sw_dir, flux_sw_dif, flux_sw_down_vis_dir
    real, intent(out),    dimension(is:ie,js:je) :: flux_sw_down_vis_dif, flux_sw_down_total_dir
    real, intent(out),    dimension(is:ie,js:je) :: flux_sw_down_total_dif, flux_sw_vis
    real, intent(out),    dimension(is:ie,js:je) :: flux_sw_vis_dir, flux_sw_vis_dif
    real, intent(out),    dimension(is:ie,js:je) :: flux_lw
    ! third dimension is the tracer number, 1=humidity
    real, intent(out),    dimension(:,:,:) :: delta_tr
    real, intent(out),    dimension(:,:,:) :: dflux_tr
    real, intent(out),    dimension(is:ie,js:je) :: delta_t
    real, intent(out),    dimension(is:ie,js:je) :: dflux_t
    real, intent(out),    dimension(is:ie,js:je) :: dtmass
    real, intent(out),    dimension(is:ie,js:je) :: delta_u
    real, intent(out),    dimension(is:ie,js:je) :: delta_v

    integer :: ierror

    write (*,*) 'aeolus2fms_atmosphere_down starting at', Time_days, Time_seconds, dayoftheyear

    ! send all input parameters to aeolus2fms.py with tags 200ff
    call MPI_Send(Time_seconds, 1, MPI_INT, peer_pe, 200, inter_comm, ierror)
    call MPI_Send(Time_days,    1, MPI_INT, peer_pe, 201, inter_comm, ierror)
    call MPI_Send(dayoftheyear, 1, MPI_INT, peer_pe, 202, inter_comm, ierror)
    write (*,*) 'aeolus2fms_atmosphere_down sent Time info'

    call MPI_Send(frac_land,      size(frac_land),      MPI_DOUBLE, peer_pe, 203, inter_comm, ierror)
    call MPI_Send(t_surf,         size(t_surf),         MPI_DOUBLE, peer_pe, 204, inter_comm, ierror)
    call MPI_Send(albedo,         size(albedo),         MPI_DOUBLE, peer_pe, 205, inter_comm, ierror)
    call MPI_Send(albedo_vis_dir, size(albedo_vis_dir), MPI_DOUBLE, peer_pe, 206, inter_comm, ierror)
    call MPI_Send(albedo_nir_dir, size(albedo_nir_dir), MPI_DOUBLE, peer_pe, 207, inter_comm, ierror)
    call MPI_Send(albedo_vis_dif, size(albedo_vis_dif), MPI_DOUBLE, peer_pe, 208, inter_comm, ierror)
    call MPI_Send(albedo_nir_dif, size(albedo_nir_dif), MPI_DOUBLE, peer_pe, 209, inter_comm, ierror)
    call MPI_Send(rough_mom,      size(rough_mom),      MPI_DOUBLE, peer_pe, 210, inter_comm, ierror)
    call MPI_Send(u_star,         size(u_star),         MPI_DOUBLE, peer_pe, 211, inter_comm, ierror)
    call MPI_Send(b_star,         size(b_star),         MPI_DOUBLE, peer_pe, 212, inter_comm, ierror)
    call MPI_Send(q_star,         size(q_star),         MPI_DOUBLE, peer_pe, 213, inter_comm, ierror)
    call MPI_Send(dtau_du,        size(dtau_du),        MPI_DOUBLE, peer_pe, 214, inter_comm, ierror)
    call MPI_Send(dtau_dv,        size(dtau_dv),        MPI_DOUBLE, peer_pe, 215, inter_comm, ierror)
    call MPI_Send(u_flux,         size(u_flux),         MPI_DOUBLE, peer_pe, 216, inter_comm, ierror)
    call MPI_Send(v_flux,         size(v_flux),         MPI_DOUBLE, peer_pe, 217, inter_comm, ierror)
    call MPI_Send(coszen,         size(coszen),         MPI_DOUBLE, peer_pe, 218, inter_comm, ierror)
    ! solar is 1-D !
    write(*,*) 'sending solar data size', size(solar)
    call MPI_Send(solar,          size(solar),          MPI_DOUBLE, peer_pe, 219, inter_comm, ierror)
    call MPI_Send(flux_lw_sf_up,  size(flux_lw_sf_up),  MPI_DOUBLE, peer_pe, 220, inter_comm, ierror)
    write (*,*) 'aeolus2fms_atmosphere_down sent atmos arrays'

    ! receive output parameters
    write (*,*) 'TODO aeolus2fms_atmosphere_down receive output parameters' ; call flush(6)
    ! (pass data as separate 2-D arrays for each tracer)

  end subroutine aeolus2fms_atmosphere_down


  subroutine aeolus2fms_atmosphere_up ( &
       ! input parameters
       Time_year, Time_month,   &
       Time_seconds, Time_days, & ! seconds-of-day and days-since-time-axis-start
       frac_land,               &
       delta_t,                 &
       delta_tr,                &
       ! output parameters
       lprec, fprec, gust,      &
       ! input parameters again
       u_star, b_star, q_star   &
       )
    integer, intent(in) :: Time_year, Time_month
    integer, intent(in) :: Time_seconds, Time_days
    real, intent(in),     dimension(is:ie,js:je) :: frac_land
    real, intent(in),     dimension(is:ie,js:je) :: delta_t
    ! third dimension is the tracer number, 1=humidity
    real, intent(in),     dimension(:,:,:) :: delta_tr
    real, intent(out),    dimension(is:ie,js:je) :: lprec, fprec, gust
    real, intent(in),     dimension(is:ie,js:je) :: u_star, b_star, q_star

    integer :: ierror

    write (*,*) 'aeolus2fms_atmosphere_up starting at', Time_year, Time_month, Time_days, Time_seconds

    ! send all input parameters to aeolus2fms.py with tags 100ff
    call MPI_Send(Time_year,    1, MPI_INT, peer_pe, 100, inter_comm, ierror)
    call MPI_Send(Time_month,   1, MPI_INT, peer_pe, 101, inter_comm, ierror)
    call MPI_Send(Time_seconds, 1, MPI_INT, peer_pe, 102, inter_comm, ierror)
    call MPI_Send(Time_days,    1, MPI_INT, peer_pe, 103, inter_comm, ierror)
    write (*,*) 'aeolus2fms_atmosphere_up sent Time info'

    call MPI_Send(frac_land, size(frac_land), MPI_DOUBLE, peer_pe, 104, inter_comm, ierror)
    call MPI_Send(delta_t,   size(delta_t),   MPI_DOUBLE, peer_pe, 105, inter_comm, ierror)
    ! delta_tr is 3-D !
    call MPI_Send(delta_tr(:,:,1),size(delta_tr(:,:,1)),MPI_DOUBLE, peer_pe, 106, inter_comm, ierror)
    call MPI_Send(u_star,    size(u_star),    MPI_DOUBLE, peer_pe, 107, inter_comm, ierror)
    call MPI_Send(b_star,    size(b_star),    MPI_DOUBLE, peer_pe, 108, inter_comm, ierror)
    call MPI_Send(q_star,    size(q_star),    MPI_DOUBLE, peer_pe, 109, inter_comm, ierror)
    write (*,*) 'aeolus2fms_atmosphere_up sent atmos arrays'

    ! receive output parameters
    write (*,*) 'TODO aeolus2fms_atmosphere_up receive output parameters' ; call flush(6)
  end subroutine aeolus2fms_atmosphere_up


  subroutine aeolus2fms_finish(Time_seconds, Time_days)
    integer, intent(in) :: Time_seconds, Time_days

    integer :: ierror
    integer, dimension(2) :: aeolus2params
    aeolus2params(1) = Time_seconds
    aeolus2params(2) = Time_days
    call MPI_Send(aeolus2params, size(aeolus2params), MPI_INT, peer_pe, 72, inter_comm, ierror)
    write(*,*) 'aeolus2fms_finish sent params' ; call flush(6)

  end subroutine aeolus2fms_finish


  subroutine aeolus2fms_restart(Time_seconds, Time_days)
    integer, intent(in) :: Time_seconds, Time_days
    integer :: ierror
    integer, dimension(2) :: aeolus2params
    aeolus2params(1) = Time_seconds
    aeolus2params(2) = Time_days
    call MPI_Send(aeolus2params, size(aeolus2params), MPI_INT, peer_pe, 73, inter_comm, ierror)
    write(*,*) 'aeolus2fms_restart sent params' ; call flush(6)
  end subroutine aeolus2fms_restart

!  subroutine  aeolus2fms_get_boundary(lon_boundaries, lat_boundaries, local, &
!         lbound(lon_boundaries, dim=1), ubound(lon_boundaries, dim=1), &
!         lbound(lon_boundaries, dim=2), ubound(lon_boundaries, dim=2), &
!         lbound(lat_boundaries, dim=1), ubound(lat_boundaries, dim=1), &
!         lbound(lat_boundaries, dim=2), ubound(lat_boundaries, dim=2))
!  end subroutine aeolus2fms_get_boundary

  subroutine aeolus2fms_get_bottom_mass(t_bot, tr_bot, p_bot, z_bot, p_surf, slp)
    real, intent(out), dimension(is:ie,js:je) :: t_bot, p_bot, z_bot, p_surf, slp
    real, intent(out), dimension(:,:,:) :: tr_bot

    integer :: ierror, ierror2, status(MPI_STATUS_SIZE), count
    integer :: dummy = 42
    call MPI_Send(dummy, 1, MPI_INT, peer_pe, 80, inter_comm, ierror)
    write(*,*) 'aeolus2fms_get_bottom_mass sent request' ; call flush(6)
    call MPI_Recv(t_bot,  size(t_bot),  MPI_DOUBLE, MPI_ANY_SOURCE, 81, inter_comm, status, ierror)
    call MPI_Get_count(status, MPI_DOUBLE, count, ierror2)
    write(*,*) 'Received t_bot count ',count,' from ',status(MPI_SOURCE),' tag ',status(MPI_TAG)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('t_bot', size(t_bot), MPI_DOUBLE, 81, status, ierror)
    call MPI_Recv(tr_bot(:,:,q_ind), size(tr_bot(:,:,q_ind)), MPI_DOUBLE, MPI_ANY_SOURCE, 82, inter_comm, status, ierror)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('tr_bot_qind', size(tr_bot(:,:,q_ind)), MPI_DOUBLE, 82, status, ierror)
    call MPI_Recv(p_bot,  size(p_bot),  MPI_DOUBLE, MPI_ANY_SOURCE, 83, inter_comm, status, ierror)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('p_bot', size(p_bot), MPI_DOUBLE, 83, status, ierror)
    call MPI_Recv(z_bot,  size(z_bot),  MPI_DOUBLE, MPI_ANY_SOURCE, 84, inter_comm, status, ierror)
    call MPI_Get_count(status, MPI_DOUBLE, count, ierror2)
    write(*,*) 'Received z_bot count ',count,' from ',status(MPI_SOURCE),' tag ',status(MPI_TAG)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('z_bot', size(z_bot), MPI_DOUBLE, 84, status, ierror)
    call MPI_Recv(p_surf, size(p_surf), MPI_DOUBLE, MPI_ANY_SOURCE, 85, inter_comm, status, ierror)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('p_surf', size(p_surf), MPI_DOUBLE, 85, status, ierror)
    call MPI_Recv(slp,    size(slp),    MPI_DOUBLE, MPI_ANY_SOURCE, 86, inter_comm, status, ierror)
    if (ierror /= MPI_SUCCESS) call print_mpi_error('slp', size(slp), MPI_DOUBLE, 86, status, ierror)
    if (co2_ind /= NO_TRACER) &
         call MPI_Recv(tr_bot(:,:,co2_ind), size(tr_bot(:,:,co2_ind)), MPI_DOUBLE, MPI_ANY_SOURCE, 87, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_bottom_mass received output parameters' ; call flush(6)

  end subroutine aeolus2fms_get_bottom_mass


  subroutine aeolus2fms_get_bottom_wind(u_bot, v_bot)
    real, intent(out), dimension(is:ie,js:je) :: u_bot, v_bot

    integer :: ierror, status(MPI_STATUS_SIZE)
    integer :: dummy = 42
    call MPI_Send(dummy, 1, MPI_INT, peer_pe, 90, inter_comm, ierror)
    write(*,*) 'aeolus2fms_get_bottom_wind sent request' ; call flush(6)
    call MPI_Recv(u_bot, size(u_bot), MPI_DOUBLE, MPI_ANY_SOURCE, 91, inter_comm, status, ierror)
    call MPI_Recv(v_bot, size(v_bot), MPI_DOUBLE, MPI_ANY_SOURCE, 92, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_bottom_wind received output parameters' ; call flush(6)
  end subroutine aeolus2fms_get_bottom_wind

  subroutine aeolus2fms_get_stock_pe(idx, val)
    integer, intent(in) :: idx
    real, intent(out)   :: val
    integer :: ierror, status(MPI_STATUS_SIZE)

    call MPI_Send(idx, 1, MPI_INT, peer_pe, 70, inter_comm, ierror)
    write(*,*) 'aeolus2fms_get_stock_pe request', idx ; call flush(6)
    call MPI_Recv(val, 1, MPI_DOUBLE, MPI_ANY_SOURCE, 70, inter_comm, status, ierror)
    write(*,*) 'aeolus2fms_get_stock_pe got response', val ; call flush(6)
  end subroutine aeolus2fms_get_stock_pe

  subroutine print_mpi_error(name, len, typ, tag, status, ierror)
    character(*), intent(in) :: name
    integer, intent(in) :: len, typ, tag, status(MPI_STATUS_SIZE), ierror
    integer :: count, class, strlen, ierror2
    character(len=MPI_MAX_ERROR_STRING) :: errstring, classtring

    write(*,*) 'MPI_Recv for ',name,len,tag,' returned error ',ierror,' &
         status[SOURCE,TAG,ERROR] ',status(MPI_SOURCE),status(MPI_TAG),status(MPI_ERROR)
    call MPI_Get_count(status, typ, count, ierror2)
    write(*,*) '  received ',count,' elements of type ',typ
    call MPI_Error_class(ierror,class, ierror2)
    call MPI_Error_string(ierror,errstring,strlen,ierror2)
    call MPI_Error_string(class,classtring,strlen,ierror2)
    write(*,*) '  ierror ',ierror,errstring,' is class ',class,classtring
    call flush(6)
  end subroutine print_mpi_error

end module aeolus2fms_mod
