SUBROUTINE med_feedback_domain ( parent_grid , nested_grid ) 1,13
   USE module_domain
   USE module_configure
   IMPLICIT NONE
   TYPE(domain), POINTER :: parent_grid , nested_grid
   TYPE(domain), POINTER :: grid
   INTEGER nlev, msize
   TYPE (grid_config_rec_type)            :: config_flags
#ifdef DEREF_KLUDGE
   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
#endif

   INTERFACE

#if (EM_CORE == 1)
      SUBROUTINE feedback_domain_em_part1 ( grid, nested_grid, config_flags ,  &
!
# include "em_dummy_args.inc"
!
                 )
         USE module_domain
         USE module_configure
         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
         TYPE(domain), POINTER :: nested_grid
         TYPE (grid_config_rec_type)            :: config_flags
# include <em_dummy_decl.inc>
      END SUBROUTINE feedback_domain_em_part1


      SUBROUTINE feedback_domain_em_part2 ( grid, nested_grid, config_flags ,  &
!
# include "em_dummy_args.inc"
!
                 )
         USE module_domain
         USE module_configure
         TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
         TYPE(domain), POINTER :: nested_grid
         TYPE (grid_config_rec_type)            :: config_flags
# include <em_dummy_decl.inc>
      END SUBROUTINE feedback_domain_em_part2
#endif

#if (NMM_CORE == 1 )
#endif
#if (GRAPS_CORE == 1 )
#endif
#if (COAMPS_CORE == 1 )
#endif

   END INTERFACE

write(0,*)'entered med_feedback_domain '
write(0,*)' nested_grid%id  ',nested_grid%id

   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )

write(0,*)'back from model_to_grid_config_rec in med_feedback_domain '

   grid => nested_grid%intermediate_grid
#ifdef DEREF_KLUDGE
   sm31             = grid%sm31
   em31             = grid%em31
   sm32             = grid%sm32
   em32             = grid%em32
   sm33             = grid%sm33
   em33             = grid%em33
#endif

#ifndef DM_PARALLEL

write(0,*)' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for non-parallel '

#else

   IF      ( .FALSE. )                        THEN

#if (EM_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_EM ) THEN
     CALL feedback_domain_em_part1 ( grid, nested_grid, config_flags ,  &
!
# include "em_actual_args.inc"
!
                 )
#endif
#if (NMM_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_NMM ) THEN
     CALL wrf_message(' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for NMM ')
#endif
#if (GRAPS_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_GRAPS ) THEN
     CALL wrf_message(' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for GRAPS ')
#endif
#if (COAMPS_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_COAMPS ) THEN
     CALL wrf_message(' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for COAMPS ')
#endif

   ELSE
     CALL wrf_message(' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for this core')

   ENDIF

   grid => parent_grid
#ifdef DEREF_KLUDGE
   sm31             = grid%sm31
   em31             = grid%em31
   sm32             = grid%sm32
   em32             = grid%em32
   sm33             = grid%sm33
   em33             = grid%em33
   sm31x            = grid%sm31x
   em31x            = grid%em31x
   sm32x            = grid%sm32x
   em32x            = grid%em32x
   sm33x            = grid%sm33x
   em33x            = grid%em33x
   sm31y            = grid%sm31y
   em31y            = grid%em31y
   sm32y            = grid%sm32y
   em32y            = grid%em32y
   sm33y            = grid%sm33y
   em33y            = grid%em33y
#endif

   IF      ( .FALSE. )                        THEN

#if (EM_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_EM ) THEN
     CALL feedback_domain_em_part2 ( grid , nested_grid%intermediate_grid, config_flags ,  &
!
# include "em_actual_args.inc"
!
                 )
#endif
#if (NMM_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_NMM) THEN
write(0,*)' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for non-parallel '
#endif
#if (SLT_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_SLT) THEN
write(0,*)' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for non-parallel '
#endif
#if (GRAPS_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_GRAPS ) THEN
write(0,*)' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for non-parallel '
#endif
#if (COAMPS_CORE == 1)
   ELSE IF ( config_flags%dyn_opt == DYN_COAMPS ) THEN
write(0,*)' W A R N I N G ----- mediation_feedback_domain.F not implemented yet for non-parallel '
#endif
   ENDIF

! #endif DM_PARALLEL
#endif

   RETURN
END SUBROUTINE med_feedback_domain