!#define ONEWAY
SUBROUTINE med_force_domain ( parent_grid , nested_grid ) 1,20
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 interp_domain_em_part1 ( grid, intermediate_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 :: intermediate_grid
TYPE (grid_config_rec_type) :: config_flags
# include <em_dummy_decl.inc>
END SUBROUTINE interp_domain_em_part1
SUBROUTINE force_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 force_domain_em_part2
SUBROUTINE couple_or_uncouple_em ( grid, config_flags , couple, &
!
# 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), INTENT(INOUT) :: grid
TYPE (grid_config_rec_type) :: config_flags
LOGICAL, INTENT( IN) :: couple
# include <em_dummy_decl.inc>
END SUBROUTINE couple_or_uncouple_em
#endif
#if (NMM_CORE == 1)
#endif
#if (GRAPS_CORE == 1)
#endif
#if (COAMPS_CORE == 1)
#endif
#if (SLT_CORE == 1)
#endif
END INTERFACE
write(0,*)'entered med_force_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_force_domain '
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
write(0,*)' med_force_domain 1'
#ifndef DM_PARALLEL
IF ( .FALSE. ) THEN
#if (EM_CORE == 1)
ELSE IF ( config_flags%dyn_opt == DYN_EM ) THEN
!***** couple variables for both parent and nest
CALL couple_or_uncouple_em
( grid , config_flags , .true., &
!
# include "em_actual_args.inc"
!
)
CALL couple_or_uncouple_em
( nested_grid , config_flags , .true., &
!
# include "em_actual_args.inc"
!
)
CALL interp_domain_em_part1
( grid , nested_grid, config_flags , &
!
# include "em_actual_args.inc"
!
)
!***** uncouple variables for both parent and nest (i.e., put back in original form)
CALL couple_or_uncouple_em
( grid , config_flags , .false., &
!
# include "em_actual_args.inc"
!
)
CALL couple_or_uncouple_em
( nested_grid , config_flags , .false., &
!
# include "em_actual_args.inc"
!
)
#endif
#if (NMM_CORE == 1)
#endif
#if (GRAPS_CORE == 1)
#endif
#if (COAMPS_CORE == 1)
#endif
#if (SLT_CORE == 1)
#endif
ENDIF
#else
IF ( .FALSE. ) THEN
#if (EM_CORE == 1)
ELSE IF ( config_flags%dyn_opt == DYN_EM ) THEN
grid => parent_grid
CALL couple_or_uncouple_em
( grid , config_flags , .true., &
!
# include "em_actual_args.inc"
!
)
grid => nested_grid
CALL couple_or_uncouple_em
( nested_grid , config_flags , .true., &
!
# include "em_actual_args.inc"
!
)
grid => parent_grid
CALL interp_domain_em_part1
( grid , nested_grid%intermediate_grid, config_flags , &
!
# include "em_actual_args.inc"
!
)
#endif
ENDIF
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
IF ( .FALSE. ) THEN
#if (EM_CORE == 1)
ELSE IF ( config_flags%dyn_opt == DYN_EM ) THEN
CALL force_domain_em_part2
( grid, nested_grid, config_flags , &
!
#include "em_actual_args.inc"
!
)
grid => parent_grid
#ifdef DEREF_KLUDGE
sm31 = grid%sm31
em31 = grid%em31
sm32 = grid%sm32
em32 = grid%em32
sm33 = grid%sm33
em33 = grid%em33
#endif
CALL couple_or_uncouple_em
( grid , config_flags , .false. , &
!
# include "em_actual_args.inc"
!
)
grid => nested_grid
#ifdef DEREF_KLUDGE
sm31 = grid%sm31
em31 = grid%em31
sm32 = grid%sm32
em32 = grid%em32
sm33 = grid%sm33
em33 = grid%em33
#endif
CALL couple_or_uncouple_em
( nested_grid , config_flags , .false. , &
!
# include "em_actual_args.inc"
!
)
#endif
#if (NMM_CORE == 1)
#endif
#if (GRAPS_CORE == 1)
#endif
#if (COAMPS_CORE == 1)
#endif
#if (SLT_CORE == 1)
#endif
ENDIF
! DM_PARALLEL
#endif
nested_grid%dtbc = 0.
RETURN
END SUBROUTINE med_force_domain