share/mediation_feedback_domain.F

   1 !
   2 !WRF:MEDIATION_LAYER:NESTING
   3 !
   4 SUBROUTINE med_feedback_domain ( parent_grid , nested_grid )
   5    USE module_timing, only: now_time
   6    USE module_domain
   7    USE module_configure
   8 !   USE module_intermediate_nmm
   9 #ifdef DM_PARALLEL
  10    USE module_dm, ONLY: local_communicator, intercomm_active
  11 #else
  12    USE module_dm, ONLY: intercomm_active
  13 #endif
  14    IMPLICIT NONE
  15    TYPE(domain), POINTER :: parent_grid , nested_grid
  16    TYPE(domain), POINTER :: grid
  17    INTEGER nlev, msize
  18 #if !defined(MAC_KLUDGE)
  19    TYPE (grid_config_rec_type)            :: config_flags
  20 #endif
  21 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  22    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
  23    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  24    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  25    character*255 :: message
  26 ! ----------------------------------------------------------
  27 ! ------------------------------------------------------
  28 ! Interface blocks
  29 ! ------------------------------------------------------
  30    INTERFACE
  31 ! ------------------------------------------------------
  32 !    Interface definitions for EM CORE
  33 ! ------------------------------------------------------
  34 #if (EM_CORE == 1)
  35 #if !defined(MAC_KLUDGE)
  36 ! ------------------------------------------------------
  37 !    These routines are supplied by module_dm.F from the
  38 !    external communication package (e.g. external/RSL)
  39 ! ------------------------------------------------------
  40       SUBROUTINE feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
  41 !
  42 #          include "dummy_new_args.inc"
  43 !
  44                                           )
  45          USE module_domain
  46          USE module_configure
  47          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  48          TYPE(domain), POINTER :: nested_grid
  49          TYPE (grid_config_rec_type)            :: config_flags
  50 #        include "dummy_new_decl.inc"
  51       END SUBROUTINE feedback_domain_em_part1
  52       SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
  53 !
  54 #          include "dummy_new_args.inc"
  55 !
  56                                           )
  57          USE module_domain
  58          USE module_configure
  59          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  60          TYPE(domain), POINTER :: intermediate_grid
  61          TYPE(domain), POINTER :: nested_grid
  62          TYPE (grid_config_rec_type)            :: config_flags
  63 #        include "dummy_new_decl.inc"
  64       END SUBROUTINE feedback_domain_em_part2
  65       SUBROUTINE update_after_feedback_em ( grid  &
  66 !
  67 #          include "dummy_new_args.inc"
  68 !
  69                                           )
  70          USE module_domain
  71          USE module_configure
  72          TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
  73 #        include "dummy_new_decl.inc"
  74       END SUBROUTINE update_after_feedback_em
  75 #endif
  76 #endif
  77    END INTERFACE
  78 ! ----------------------------------------------------------
  79 ! End of Interface blocks
  80 ! ----------------------------------------------------------
  81 ! ----------------------------------------------------------
  82 ! ----------------------------------------------------------
  83 ! Executable code
  84 ! ----------------------------------------------------------
  85 ! ----------------------------------------------------------
  86 !    Feedback calls for EM CORE.
  87 ! ----------------------------------------------------------
  88 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
  89 # if !defined(MAC_KLUDGE)
  90    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
  91    parent_grid%ht_coarse = parent_grid%ht
  92    grid => nested_grid%intermediate_grid
  93 #  if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
  94    CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. , intercomm_active( grid%id ),    &
  95                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
  96                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
  97                             grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
  98                             grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
  99                             grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
 100                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 101                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 102      )
 103 #  endif
 104    CALL wrf_dm_nestexchange_init
 105   IF ( nested_grid%active_this_task ) THEN
 106    grid => nested_grid%intermediate_grid
 107    CALL feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
 108 !
 109 #      include "actual_new_args.inc"
 110 !
 111                                    )
 112   ENDIF
 113    grid => parent_grid
 114
 115    grid%nest_mask = 0.
 116
 117    CALL feedback_domain_em_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags   &
 118 !
 119 #      include "actual_new_args.inc"
 120
 121                                    )
 122
 123    WHERE   ( grid%nest_pos .NE. 9021000.  ) grid%ht = grid%ht_coarse
 124    CALL push_communicators_for_domain(grid%id)
 125    CALL update_after_feedback_em ( grid  &
 126 !
 127 #      include "actual_new_args.inc"
 128 !
 129                                    )
 130    CALL pop_communicators_for_domain
 131
 132    grid => nested_grid%intermediate_grid
 133 #  if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
 134    IF ( intercomm_active( grid%id ) ) THEN
 135    CALL dealloc_space_field ( grid )
 136    ENDIF
 137 #  endif
 138 # endif
 139 #endif
 140 ! ------------------------------------------------------
 141 !    End of Feedback calls for EM CORE.
 142 ! ------------------------------------------------------
 143    RETURN
 144 END SUBROUTINE med_feedback_domain
 145
 146