!-----------------------------------------------------------------------
!
      MODULE MODULE_PARENT_CHILD_CPL_COMP
!
!-----------------------------------------------------------------------
!
!***  This module contains the coupler that exchanges data between
!***  NMM-B parent domains and their children.
!
!-----------------------------------------------------------------------
!
! PROGRAM HISTORY LOG:
!
!   2008-06-12  Black - Module created.
!   2009-02-19  Black - Hydrostatic update of nest boundaries.
!   2010-01-20  Black - Enable parent tasks to update associations
!                       with nest boundary tasks throughout the
!                       integration.
!   2011-02     Yang  - Updated to use both the ESMF 4.0.0rp2 library,
!                       ESMF 5 series library and the the
!                       ESMF 3.1.0rp2 library.
!   2011-05-12  Yang  - Modified for using the ESMF 5.2.0r_beta_snapshot_07.
!   2011-07-16  Black - Add moving nest capability.
!   2011-09-27  Yang  - Modified for using the ESMF 5.2.0r library.
!   2012-07-20  Black - Add generational use of MPI tasks.
!
!-----------------------------------------------------------------------
!
! USAGE: 
!
!-----------------------------------------------------------------------
!
      USE MPI
      USE ESMF
!
      USE module_KINDS
!
      USE module_DERIVED_TYPES,ONLY: BC_H                               &
                                    ,BC_V                               &
                                    ,BNDS_2D                            &
                                    ,CHILD_UPDATE_LINK                  &
                                    ,CTASK_LIMITS                       &
                                    ,HANDLE_CHILD_LIMITS                &
                                    ,HANDLE_CHILD_TOPO_S                &
                                    ,HANDLE_CHILD_TOPO_N                &
                                    ,HANDLE_CHILD_TOPO_W                &
                                    ,HANDLE_CHILD_TOPO_E                &
                                    ,HANDLE_I_SW                        &
                                    ,HANDLE_J_SW                        &
                                    ,HANDLE_PACKET_S_H                  &
                                    ,HANDLE_PACKET_S_V                  &
                                    ,HANDLE_PACKET_N_H                  &
                                    ,HANDLE_PACKET_N_V                  &
                                    ,HANDLE_PACKET_W_H                  &
                                    ,HANDLE_PACKET_W_V                  &
                                    ,HANDLE_PACKET_E_H                  &
                                    ,HANDLE_PACKET_E_V                  &
                                    ,HANDLE_PARENT_DOM_LIMITS           &
                                    ,HANDLE_PARENT_ITE                  &
                                    ,HANDLE_PARENT_ITS                  &
                                    ,HANDLE_PARENT_JTE                  &
                                    ,HANDLE_PARENT_JTS                  &
                                    ,INFO_SEND                          &
                                    ,INTEGER_DATA                       &
                                    ,INTEGER_DATA_2D                    &
                                    ,INTERIOR_DATA_FROM_PARENT          &
                                    ,MIXED_DATA                         &
                                    ,MIXED_DATA_TASKS                   &
                                    ,MULTIDATA                          &
                                    ,REAL_DATA                          &
                                    ,REAL_DATA_TASKS                    &
                                    ,PTASK_LIMITS                       &
                                    ,REAL_DATA_2D                       &
                                    ,REAL_VBLS_3D
!
      USE module_CONTROL,ONLY: NUM_DOMAINS_MAX,TIMEF
!
      USE module_EXCHANGE,ONLY: HALO_EXCH
!
      USE module_VARS,ONLY: VAR
!
      USE module_NESTING,ONLY: CHECK_REAL                               &
                              ,CHILD_2WAY_BOOKKEEPING                   &
                              ,CHILD_RANKS                              &
                              ,GENERATE_2WAY_DATA                       &
                              ,HYPERBOLA                                &
                              ,LAG_STEPS                                &
                              ,MOVING_NEST_BOOKKEEPING                  &
                              ,MOVING_NEST_RECV_DATA                    &
                              ,PARENT_2WAY_BOOKKEEPING                  &
                              ,PARENT_BOOKKEEPING_MOVING                &
                              ,PARENT_READS_MOVING_CHILD_TOPO           &
                              ,PARENT_UPDATES_HALOS                     &
                              ,PARENT_UPDATES_MOVING                    &
                              ,STENCIL_H_EVEN                           &
                              ,STENCIL_V_EVEN                           &
                              ,STENCIL_SFC_H_EVEN                       &
                              ,STENCIL_SFC_V_EVEN                       &
                              ,STENCIL_H_ODD                            &
                              ,STENCIL_V_ODD                            &
                              ,STENCIL_SFC_H_ODD                        &
                              ,STENCIL_SFC_V_ODD  
!
      USE module_CONSTANTS,ONLY: A,G,P608,R_D
!
      USE MODULE_MY_DOMAIN_SPECS, IDS_share=>IDS,IDE_share=>IDE         &
                                 ,IMS_share=>IMS,IME_share=>IME         &
                                 ,ITS_share=>ITS,ITE_share=>ITE         &
                                 ,JDS_share=>JDS,JDE_share=>JDE         &
                                 ,JMS_share=>JMS,JME_share=>JME         &
                                 ,JTS_share=>JTS,JTE_share=>JTE         &
!
                                 ,MPI_COMM_COMP_share=>MPI_COMM_COMP    &
                                 ,MYPE_share=>MYPE                      &
                                 ,MY_NEB_share=>MY_NEB                  &
!
                                 ,LOCAL_ISTART_share=>LOCAL_ISTART      &
                                 ,LOCAL_IEND_share  =>LOCAL_IEND        &
                                 ,LOCAL_JSTART_share=>LOCAL_JSTART      &
                                 ,LOCAL_JEND_share  =>LOCAL_JEND
!
      USE module_CLOCKTIMES,ONLY: cbcst_tim,pbcst_tim
!
      USE module_DIAGNOSE,ONLY: HMAXMIN,VMAXMIN
!
      USE module_ERROR_MSG,ONLY: ERR_MSG,MESSAGE_CHECK
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      PRIVATE
!
      PUBLIC :: PARENT_CHILD_CPL_REGISTER                               &
               ,PARENT_CHILD_COUPLER_SETUP                              &
               ,NSTEP_CHILD_RECV
!
!-----------------------------------------------------------------------
!
      TYPE BOUNDARY_SIDES                                                 !<-- Hold the boundary blending region along each side of a domain
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: SOUTH
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: NORTH
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEST 
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: EAST
      END TYPE BOUNDARY_SIDES
!
      TYPE INTEGER_DATA_TASKS 
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: TASKS        
      END TYPE INTEGER_DATA_TASKS 
!
      TYPE SIDES_0D 
        INTEGER(kind=KINT) :: SOUTH           
        INTEGER(kind=KINT) :: NORTH
        INTEGER(kind=KINT) :: WEST
        INTEGER(kind=KINT) :: EAST
      END TYPE SIDES_0D
!
      TYPE SIDES_2D
        INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: SOUTH           
        INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: NORTH
        INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: WEST
        INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: EAST
      END TYPE SIDES_2D
!
      TYPE SAVE_TASK_IJ                                
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_LO_SOUTH    
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_HI_SOUTH
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_HI_SOUTH_TRANSFER
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_LO_NORTH
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_HI_NORTH
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_HI_NORTH_TRANSFER
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_LO_WEST
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_HI_WEST
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_HI_WEST_TRANSFER
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_LO_EAST
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_HI_EAST
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_HI_EAST_TRANSFER
      END TYPE SAVE_TASK_IJ
!
      TYPE HANDLE_SEND         
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NTASKS_TO_RECV          !<-- Parent MPI handles used when ISend'ing to each child task 
      END TYPE HANDLE_SEND       
!
      TYPE DATA_INFO
        REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: STRING
        INTEGER(kind=KINT) :: LENGTH
        INTEGER(kind=KINT) :: ID_SOURCE
        INTEGER(kind=KINT) :: INDX_START
        INTEGER(kind=KINT) :: INDX_END
        INTEGER(kind=KINT) :: INDX_END_EXP
      END TYPE DATA_INFO
!
      TYPE PARENT_DATA
        TYPE(DATA_INFO) :: SOUTH_H
        TYPE(DATA_INFO) :: SOUTH_V
        TYPE(DATA_INFO) :: NORTH_H
        TYPE(DATA_INFO) :: NORTH_V
        TYPE(DATA_INFO) :: WEST_H
        TYPE(DATA_INFO) :: WEST_V
        TYPE(DATA_INFO) :: EAST_H
        TYPE(DATA_INFO) :: EAST_V
      END TYPE PARENT_DATA
!
      TYPE PARENT_POINTS_SURROUND_H                                       !<-- Indices of parent points around each child bndry H point
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_NBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_SBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_EBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_WBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_NBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_SBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_EBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_WBND
      END TYPE PARENT_POINTS_SURROUND_H
!
      TYPE PARENT_POINTS_SURROUND_V                                        !<-- Indices of parent points around each child bndry V point
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_NBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_SBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_EBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_WBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_NBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_SBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_EBND
        INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: J_INDX_WBND
      END TYPE PARENT_POINTS_SURROUND_V
!
      TYPE PARENT_WEIGHTS_SURROUND_H                                       !<-- Bilinear interpolation weights of the 4 parent points
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_NBND           !     around each child boundary H point
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_SBND
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_EBND
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_WBND
      END TYPE PARENT_WEIGHTS_SURROUND_H
!
      TYPE PARENT_WEIGHTS_SURROUND_V                                       !<-- Bilinear interpolation weights of the 4 parent points
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_NBND           !     around each child boundary H point
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_SBND
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_EBND
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHTS_WBND
      END TYPE PARENT_WEIGHTS_SURROUND_V
!
!-----------------------------------------------------------------------
!***  In 1-way nesting the MPI tasks lie on only one domain but
!***  in 2-way nesting the tasks can lie on more than one domain.
!***  The composite object holds quantities in the Parent-Child
!***  coupler that vary depending on which domain they are on.
!***  The composite object differentiates between the quantities
!***  inside it.  The tasks point into the proper element of the
!***  object with unallocated pointers to access the quantities
!***  for the desired domain.
!-----------------------------------------------------------------------
!
!-----------------------------------
!***  The composite type definition
!-----------------------------------
!
      TYPE COMPOSITE
!
        INTEGER(kind=KINT) :: NCYCLE_CHILD                              &
                             ,NCYCLE_PARENT
!
        INTEGER(kind=KINT) :: COMM_TO_MY_PARENT
        INTEGER(kind=KINT) :: HANDLE_MOVE_FLAG
        INTEGER(kind=KINT) :: HANDLE_SEND_2WAY_SIGNAL
        INTEGER(kind=KINT) :: I_CENTER_CURRENT
        INTEGER(kind=KINT) :: I_SHIFT_CHILD
        INTEGER(kind=KINT) :: J_SHIFT_CHILD
        INTEGER(kind=KINT) :: I_SW_PARENT_CURRENT
        INTEGER(kind=KINT) :: I_SW_PARENT_NEW
        INTEGER(kind=KINT) :: J_CENTER_CURRENT
        INTEGER(kind=KINT) :: J_SW_PARENT_CURRENT
        INTEGER(kind=KINT) :: J_SW_PARENT_NEW
        INTEGER(kind=KINT) :: ITS,ITE,JTS,JTE,LM
        INTEGER(kind=KINT) :: IMS,IME,JMS,JME
        INTEGER(kind=KINT) :: IDS,IDE,JDS,JDE
        INTEGER(kind=KINT) :: IM_1,JM_1,JM
        INTEGER(kind=KINT) :: INPES,JNPES
        INTEGER(kind=KINT) :: INPES_PARENT,JNPES_PARENT
        INTEGER(kind=KINT) :: KOUNT_2WAY_CHILDREN
        INTEGER(kind=KINT) :: LAST_STEP_MOVED
        INTEGER(kind=KINT) :: MAX_SHIFT
        INTEGER(kind=KINT) :: MYPE
        INTEGER(kind=KINT) :: N_BLEND_H,N_BLEND_V
        INTEGER(kind=KINT) :: N_STENCIL_H,N_STENCIL_SFC_H
        INTEGER(kind=KINT) :: N_STENCIL_V,N_STENCIL_SFC_V
        INTEGER(kind=KINT) :: NEXT_MOVE_TIMESTEP
        INTEGER(kind=KINT) :: NHALO
        INTEGER(kind=KINT) :: NLEV_H
        INTEGER(kind=KINT) :: NLEV_V
        INTEGER(kind=KINT) :: NPHS
        INTEGER(kind=KINT) :: NTASKS_UPDATE_PARENT
        INTEGER(kind=KINT) :: NTIMESTEP_CHECK  
        INTEGER(kind=KINT) :: NTIMESTEP_FINAL
        INTEGER(kind=KINT) :: NTIMESTEP_WAIT_PARENT
        INTEGER(kind=KINT) :: NTIMESTEP_WAIT_FORCED_PARENT
        INTEGER(kind=KINT) :: NTIMESTEPS_RESTART
        INTEGER(kind=KINT) :: NTOT_SFC
        INTEGER(kind=KINT) :: NTRACK
        INTEGER(kind=KINT) :: NUM_CHILDREN
        INTEGER(kind=KINT) :: NUM_2WAY_CHILDREN
        INTEGER(kind=KINT) :: NUM_MOVING_CHILDREN
        INTEGER(kind=KINT) :: NUM_PES_FCST
        INTEGER(kind=KINT) :: NUM_FCST_TASKS_PARENT
        INTEGER(kind=KINT) :: NUM_TASKS_PARENT
        INTEGER(kind=KINT) :: NUM_LEVELS_MOVE_3D_H
        INTEGER(kind=KINT) :: NUM_LEVELS_MOVE_3D_V
        INTEGER(kind=KINT) :: NUM_SPACE_RATIOS_MVG
        INTEGER(kind=KINT) :: NVARS_BC_2D_H
        INTEGER(kind=KINT) :: NVARS_BC_3D_H
        INTEGER(kind=KINT) :: NVARS_BC_4D_H
        INTEGER(kind=KINT) :: NVARS_BC_2D_V
        INTEGER(kind=KINT) :: NVARS_BC_3D_V
        INTEGER(kind=KINT) :: SPACE_RATIO_MY_PARENT
        INTEGER(kind=KINT) :: TIME_RATIO_MY_PARENT
!
        INTEGER(kind=KINT),DIMENSION(1:2) :: MY_FORCED_SHIFT
        INTEGER(kind=KINT),DIMENSION(1:2) :: STORM_CENTER   
        INTEGER(kind=KINT),DIMENSION(1:3) :: PARENT_SHIFT
        INTEGER(kind=KINT),DIMENSION(1:4) :: MY_DOMAIN_LIMITS
        INTEGER(kind=KINT),DIMENSION(1:4) :: PARENT_DOMAIN_LIMITS
        INTEGER(kind=KINT),DIMENSION(1:8) :: MY_NEB
!
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: PARENT_CHILD_SPACE_RATIO  
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: TIME_RATIO_MY_CHILDREN
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: IM_CHILD                  
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: JM_CHILD                  
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_PARENT_SW
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: J_PARENT_SW
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: ITE_PARENT
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: ITS_PARENT
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: JTE_PARENT
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: JTS_PARENT
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LINK_MRANK_RATIO
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LIST_OF_RATIOS
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: M_NEST_RATIO
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_BLEND_H_CHILD           
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_BLEND_V_CHILD           
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_STENCIL_H_CHILD
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_STENCIL_SFC_H_CHILD
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_STENCIL_V_CHILD
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: N_STENCIL_SFC_V_CHILD
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NTASKS_UPDATE_CHILD
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NSTEP_CHILD_RECV          
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: INC_FIX                   
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: COMM_TO_MY_CHILDREN
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: ID_PARENTS
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: ID_PARENT_UPDATE_TASKS
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: MY_CHILDREN_ID
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: RANK_2WAY_CHILD  
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: RANK_MOVING_CHILD  
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: FTASKS_DOMAIN
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NTASKS_DOMAIN
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NPTS_UPDATE_ON_PARENT_TASKS
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_BC_UPDATE
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_PARENT_SHIFT
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_TIMESTEP
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_SEND_2WAY_DATA
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_SEND_2WAY_SFC
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_SEND_ALLCLEAR
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LBND_4D
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: UBND_4D
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LOCAL_ISTART
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LOCAL_IEND
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LOCAL_JSTART
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: LOCAL_JEND
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NTIMESTEP_CHILD_MOVES
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_H_S
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_H_N
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_H_W
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_H_E
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_V_S
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_V_N
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_V_W
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_TASKS_SEND_V_E
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: SHIFT_INFO_MINE
!
        INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: SHIFT_INFO_CHILDREN
!
        REAL(kind=KFPT) :: CENTERS_DISTANCE
        REAL(kind=KFPT) :: DLM
        REAL(kind=KFPT) :: DPH
        REAL(kind=KFPT) :: DYH
        REAL(kind=KFPT) :: PDTOP
        REAL(kind=KFPT) :: PT
        REAL(kind=KFPT) :: SB_1
        REAL(kind=KFPT) :: WB_1
        REAL(kind=KFPT) :: TPH0_1
        REAL(kind=KFPT) :: TLM0_1
        REAL(kind=KFPT) :: RECIP_DPH_1
        REAL(kind=KFPT) :: RECIP_DLM_1
        REAL(kind=KFPT) :: RECIP_PARENT_SPACE_RATIO
!
        REAL(kind=KFPT),DIMENSION(:),POINTER :: DT_DOMAIN
        REAL(kind=KFPT),DIMENSION(:),POINTER :: DXH
        REAL(kind=KFPT),DIMENSION(:),POINTER :: DSG2
        REAL(kind=KFPT),DIMENSION(:),POINTER :: PDSG1
        REAL(kind=KFPT),DIMENSION(:),POINTER :: PSGML1
        REAL(kind=KFPT),DIMENSION(:),POINTER :: SG1
        REAL(kind=KFPT),DIMENSION(:),POINTER :: SG2
        REAL(kind=KFPT),DIMENSION(:),POINTER :: SGML2
!
        REAL(kind=KFPT),DIMENSION(:),POINTER :: CHILD_2WAY_WGT
        REAL(kind=KFPT),DIMENSION(:),POINTER :: CHILD_PARENT_SPACE_RATIO  
!
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_SOUTH_H
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_SOUTH_V
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_NORTH_H
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_NORTH_V
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_WEST_H
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_WEST_V
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_EAST_H
        REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_EAST_V
!
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: FIS
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: FIS_CHILD_ON_PARENT
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: GLAT
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: GLON
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PD
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: SM
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: U10
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: V10
!
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PDB_S
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PDB_N
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PDB_W
        REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PDB_E
!
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: CW
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: PINT
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: Q
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: T
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: U
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: V
        REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: Z
!
        REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: TRACERS
!
        CHARACTER(len=6),DIMENSION(:),POINTER :: STATIC_OR_MOVING     
!
        LOGICAL(kind=KLOG) :: CALLED_CHILD_2WAY_BOOKKEEPING
        LOGICAL(kind=KLOG) :: CHILD_FORCES_MY_SHIFT
        LOGICAL(kind=KLOG) :: FIRST_CALL_RECV_2WAY
        LOGICAL(kind=KLOG) :: FIRST_CALL_RECV_BC
        LOGICAL(kind=KLOG) :: FORCED_PARENT_SHIFT
        LOGICAL(kind=KLOG) :: I_AM_ACTIVE
        LOGICAL(kind=KLOG) :: I_AM_LEAD_FCST_TASK
        LOGICAL(kind=KLOG) :: I_WANT_TO_MOVE
        LOGICAL(kind=KLOG) :: MOVE_FLAG_SENT
        LOGICAL(kind=KLOG) :: MY_PARENT_MOVES
        LOGICAL(kind=KLOG) :: PARENT_WANTS_TO_MOVE
        LOGICAL(kind=KLOG) :: STOP_MY_MOTION
!
        LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: CHILD_ACTIVE
        LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: MOVE_FLAG
        LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: SEND_CHILD_DATA
        LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE :: CALLED_PARENT_2WAY_BOOKKEEPING
        LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE :: SIGNAL_2WAY_SEND_READY
        LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE :: SKIP_2WAY_UPDATE
!
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: I_2WAY_UPDATE
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: J_2WAY_UPDATE
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: I_2WAY_H
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: J_2WAY_H
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: I_2WAY_V
        TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: J_2WAY_V
!
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_H_SOUTH
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_H_NORTH
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_H_WEST
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_H_EAST
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_V_SOUTH
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_V_NORTH
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_V_WEST
        TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_V_EAST
!
        TYPE(REAL_DATA),DIMENSION(:),POINTER :: UPDATE_PARENT_2WAY
!
        TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: CHILD_SFC_ON_PARENT
        TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: NEST_FIS_ON_PARENT
        TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: NEST_FIS_V_ON_PARENT
!
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_SOUTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_NORTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_WEST
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_EAST
!
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_SOUTH_V
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_NORTH_V
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_WEST_V
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_EAST_V
!
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_H_SOUTH
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_H_NORTH
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_H_WEST
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_H_EAST
!
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_V_SOUTH
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_V_NORTH
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_V_WEST
        TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_V_EAST
!
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: FIS_CHILD_SOUTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: FIS_CHILD_NORTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: FIS_CHILD_WEST
        TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: FIS_CHILD_EAST
!
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_H_SOUTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_H_NORTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_H_WEST
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_H_EAST
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_V_SOUTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_V_NORTH
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_V_WEST
        TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_V_EAST
!
        TYPE(BC_H) :: MY_BC_VARS_H_S 
        TYPE(BC_H) :: MY_BC_VARS_H_N 
        TYPE(BC_H) :: MY_BC_VARS_H_W 
        TYPE(BC_H) :: MY_BC_VARS_H_E 
!
        TYPE(BC_V) :: MY_BC_VARS_V_S 
        TYPE(BC_V) :: MY_BC_VARS_V_N 
        TYPE(BC_V) :: MY_BC_VARS_V_W 
        TYPE(BC_V) :: MY_BC_VARS_V_E 
!
        TYPE(MIXED_DATA_TASKS),DIMENSION(:),POINTER :: MOVING_CHILD_UPDATE
!
        TYPE(BNDS_2D),DIMENSION(:),POINTER :: NEST_FIS_ON_PARENT_BNDS
!
        TYPE(SIDES_0D) :: INDX_MAX_H,INDX_MAX_V
        TYPE(SIDES_0D) :: INDX_MIN_H,INDX_MIN_V
        TYPE(SIDES_0D) :: NUM_PARENT_TASKS_SENDING_H
        TYPE(SIDES_0D) :: NUM_PARENT_TASKS_SENDING_V
!
        TYPE(SIDES_2D),DIMENSION(:),POINTER :: CHILDTASK_BNDRY_H_RANKS
        TYPE(SIDES_2D),DIMENSION(:),POINTER :: CHILDTASK_BNDRY_V_RANKS
!
        TYPE(SAVE_TASK_IJ),DIMENSION(:),POINTER :: CHILDTASK_H_SAVE
        TYPE(SAVE_TASK_IJ),DIMENSION(:),POINTER :: CHILDTASK_V_SAVE
!
        TYPE(PARENT_POINTS_SURROUND_H),DIMENSION(:),POINTER :: PARENT_4_INDICES_H
        TYPE(PARENT_POINTS_SURROUND_V),DIMENSION(:),POINTER :: PARENT_4_INDICES_V
!
        TYPE(PARENT_WEIGHTS_SURROUND_H),DIMENSION(:),POINTER :: PARENT_4_WEIGHTS_H
        TYPE(PARENT_WEIGHTS_SURROUND_V),DIMENSION(:),POINTER :: PARENT_4_WEIGHTS_V
!
        TYPE(PARENT_DATA),DIMENSION(:),POINTER :: PARENT_TASK
!
        TYPE(CHILD_UPDATE_LINK),DIMENSION(:),POINTER :: TASK_UPDATE_SPECS &
                                                       ,CHILD_TASKS_2WAY_UPDATE
!
        TYPE(HANDLE_SEND),DIMENSION(:),POINTER :: HANDLE_MOVE_DATA
!
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_H_SOUTH
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_H_NORTH
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_H_WEST
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_H_EAST
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_V_SOUTH
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_V_NORTH
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_V_WEST
        TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_V_EAST
!
        TYPE(ESMF_Config) :: CF_MINE   
        TYPE(ESMF_Config) :: CF_PARENT
        TYPE(ESMF_Config),DIMENSION(:),POINTER :: CF
!
        TYPE(ESMF_FieldBundle) :: BUNDLE_2WAY
        TYPE(ESMF_FieldBundle) :: BUNDLE_NESTBC
        TYPE(ESMF_FieldBundle) :: MOVE_BUNDLE_H
        TYPE(ESMF_FieldBundle) :: MOVE_BUNDLE_V
!
        LOGICAL(kind=KLOG) :: ALLCLEAR_SIGNAL_PRESENT                   &
                             ,I_AM_A_FCST_TASK                          &
                             ,I_AM_A_PARENT                             &
                             ,MY_DOMAIN_MOVES                           &
                             ,RECV_ALL_CHILD_DATA
!
        REAL(kind=KDBL) :: cpl1_prelim_tim                              &
                          ,cpl1_south_h_tim,cpl1_south_v_tim            &
                          ,cpl1_north_h_tim,cpl1_north_v_tim            &
                          ,cpl1_west_h_tim, cpl1_west_v_tim             &
                          ,cpl1_east_h_tim, cpl1_east_v_tim             &
                          ,cpl1_recv_tim
!
        REAL(kind=KDBL) :: cpl1_south_h_recv_tim                        &
                          ,cpl1_south_h_undo_tim                        &
                          ,cpl1_south_h_exp_tim                         &
                          ,cpl1_south_v_recv_tim                        &
                          ,cpl1_south_v_undo_tim                        &
                          ,cpl1_south_v_exp_tim
!
        REAL(kind=KDBL) :: cpl2_comp_tim                                &
                          ,cpl2_send_tim                                &
                          ,cpl2_wait_tim
!
        REAL(kind=KDBL) :: moving_nest_bookkeep_tim                     &
                          ,moving_nest_update_tim
!
        REAL(kind=KDBL) :: parent_bookkeep_moving_tim                   &
                          ,parent_update_moving_tim                     &
                          ,t0_recv_move_tim                             &
                          ,read_moving_child_topo_tim                   &
                          ,barrier_move_tim,pscd_tim,pscd1_tim          &
                          ,pscd2_tim,pscd3_tim,pscd4_tim
!
        REAL(kind=KDBL) :: ja1_tim,ja2_tim,ja3_tim,ja4_tim,jat_tim
!
!***  The following are for moving nests.
!
        CHARACTER(len=32) :: MOVE_TYPE
!
        INTEGER(kind=KINT) :: I_EAST_M,I_WEST_M,J_NORTH_M,J_SOUTH_M
        INTEGER(kind=KINT) :: I_MAX,I_MIN,J_MAX,J_MIN
        INTEGER(kind=KINT) :: NPTS_NS,NPTS_WE
!
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_PG,J_PG
!
        REAL(kind=KFPT) :: COEF
        REAL(kind=KFPT) :: ELAPSED_TIME_MIN
        REAL(kind=KFPT) :: RNPTS_HZ
!
        LOGICAL(kind=KLOG) :: FIRST_PASS_M
        LOGICAL(kind=KLOG) :: FIRST_STEP_2WAY
        LOGICAL(kind=KLOG) :: I_HOLD_CENTER_POINT
!
        LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: IN_WINDOW=>NULL()
        LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: I_HOLD_PG_POINT
!
!***  The following are for prescribed moves
!
        INTEGER(kind=KINT) :: MOVE_INTERVAL_MINUTES
        INTEGER(kind=KINT) :: N_MOVES
        REAL(kind=KFPT),DIMENSION(:),POINTER :: MOVE_MINUTE
        INTEGER(kind=KINT),DIMENSION(:),POINTER :: MOVE_I_SW,MOVE_J_SW
!
      END TYPE COMPOSITE
!
!-----------------------------------------------------------------------
!***  Now declare the composite object.  It will hold all of the
!***  above quantities separately for each domain a task is on.
!-----------------------------------------------------------------------
!
      TYPE(COMPOSITE),DIMENSION(:),POINTER,SAVE :: CPL_COMPOSITE           !<-- Coupler's composite object of domain variables
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Declare generic pointers that will point into the composite
!***  object.  We want to be able to do this so that the standard
!***  names of the generic pointers can be used where desired.
!-----------------------------------------------------------------------
!
      INTEGER(kind=KINT),POINTER :: NCYCLE_CHILD                        &
                                   ,NCYCLE_PARENT
!
      INTEGER(kind=KINT),POINTER :: COMM_TO_MY_PARENT                   &
                                   ,HANDLE_MOVE_FLAG                    &
                                   ,HANDLE_SEND_2WAY_SIGNAL             &
                                   ,I_CENTER_CURRENT                    &
                                   ,I_SHIFT_CHILD                       &
                                   ,J_SHIFT_CHILD                       &
                                   ,I_SW_PARENT_CURRENT                 &
                                   ,I_SW_PARENT_NEW                     &
                                   ,J_CENTER_CURRENT                    &
                                   ,J_SW_PARENT_CURRENT                 &
                                   ,J_SW_PARENT_NEW                     &
                                   ,ITS,ITE,JTS,JTE,LM                  &
                                   ,IMS,IME,JMS,JME                     &
                                   ,IDS,IDE,JDS,JDE                     &
                                   ,IM_1,JM_1                           &
                                   ,INPES,JNPES                         &
                                   ,INPES_PARENT,JNPES_PARENT           &
                                   ,JM                                  &
                                   ,KOUNT_2WAY_CHILDREN                 &
                                   ,LAST_STEP_MOVED                     &
                                   ,MAX_SHIFT                           &
                                   ,MYPE                                &
                                   ,N_BLEND_H,N_BLEND_V                 &
                                   ,N_STENCIL_H,N_STENCIL_SFC_H         &
                                   ,N_STENCIL_V,N_STENCIL_SFC_V         &
                                   ,NHALO                               &
                                   ,NLEV_H                              &
                                   ,NLEV_V                              &
                                   ,NPHS                                &
                                   ,NTASKS_UPDATE_PARENT                &
                                   ,NTIMESTEP_CHECK                     &
                                   ,NTIMESTEP_FINAL                     &
                                   ,NTIMESTEP_WAIT_PARENT               &
                                   ,NTIMESTEP_WAIT_FORCED_PARENT        &
                                   ,NTIMESTEPS_RESTART                  &
                                   ,NTOT_SFC                            &
                                   ,NTRACK                              &
                                   ,NUM_CHILDREN                        &
                                   ,NUM_2WAY_CHILDREN                   &
                                   ,NUM_MOVING_CHILDREN                 &
                                   ,NUM_PES_FCST                        &
                                   ,NUM_FCST_TASKS_PARENT               &
                                   ,NUM_TASKS_PARENT                    &
                                   ,NEXT_MOVE_TIMESTEP                  &
                                   ,NUM_LEVELS_MOVE_3D_H                &
                                   ,NUM_LEVELS_MOVE_3D_V                &
                                   ,NUM_SPACE_RATIOS_MVG                &
                                   ,NVARS_BC_2D_H                       &
                                   ,NVARS_BC_3D_H                       &
                                   ,NVARS_BC_4D_H                       &
                                   ,NVARS_BC_2D_V                       &
                                   ,NVARS_BC_3D_V                       &
                                   ,SPACE_RATIO_MY_PARENT               &
                                   ,TIME_RATIO_MY_PARENT
!                                         
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: DOMAIN_ID_TO_RANK      &
                                                ,MY_DOMAIN_LIMITS       &
                                                ,MY_FORCED_SHIFT        &
                                                ,MY_NEB                 &
                                                ,PARENT_DOMAIN_LIMITS   &
                                                ,PARENT_SHIFT           & 
                                                ,STORM_CENTER
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: PARENT_CHILD_SPACE_RATIO    &
                                                ,TIME_RATIO_MY_CHILDREN      &
                                                ,IM_CHILD                    &
                                                ,JM_CHILD                    &
                                                ,I_PARENT_SW                 &
                                                ,J_PARENT_SW                 &
                                                ,ITE_PARENT                  &
                                                ,ITS_PARENT                  &
                                                ,JTE_PARENT                  &
                                                ,JTS_PARENT                  &
                                                ,LBND_4D                     &
                                                ,UBND_4D                     &
                                                ,LINK_MRANK_RATIO            &
                                                ,LIST_OF_RATIOS              &
                                                ,LOCAL_ISTART                &
                                                ,LOCAL_IEND                  &
                                                ,LOCAL_JSTART                &
                                                ,LOCAL_JEND                  &
                                                ,M_NEST_RATIO                &
                                                ,N_BLEND_H_CHILD             &
                                                ,N_BLEND_V_CHILD             &
                                                ,N_STENCIL_H_CHILD           &
                                                ,N_STENCIL_SFC_H_CHILD       &
                                                ,N_STENCIL_V_CHILD           &
                                                ,N_STENCIL_SFC_V_CHILD       &
                                                ,NTASKS_UPDATE_CHILD         &
                                                ,NSTEP_CHILD_RECV            &
                                                ,INC_FIX                     &
                                                ,COMM_TO_MY_CHILDREN         &
                                                ,ID_PARENTS                  &
                                                ,ID_PARENT_UPDATE_TASKS      &
                                                ,MY_CHILDREN_ID              &
                                                ,RANK_2WAY_CHILD             &
                                                ,RANK_MOVING_CHILD           &
                                                ,FTASKS_DOMAIN               &
                                                ,NTASKS_DOMAIN               &
                                                ,NPTS_UPDATE_ON_PARENT_TASKS &
                                                ,HANDLE_BC_UPDATE            &
                                                ,HANDLE_PARENT_SHIFT         &
                                                ,HANDLE_TIMESTEP             &
                                                ,HANDLE_SEND_2WAY_DATA       &
                                                ,HANDLE_SEND_2WAY_SFC        &
                                                ,HANDLE_SEND_ALLCLEAR        &
                                                ,NTIMESTEP_CHILD_MOVES       &
                                                ,NUM_TASKS_SEND_H_S          &
                                                ,NUM_TASKS_SEND_H_N          &
                                                ,NUM_TASKS_SEND_H_W          &
                                                ,NUM_TASKS_SEND_H_E          &
                                                ,NUM_TASKS_SEND_V_S          &
                                                ,NUM_TASKS_SEND_V_N          &
                                                ,NUM_TASKS_SEND_V_W          &
                                                ,NUM_TASKS_SEND_V_E          &
                                                ,SHIFT_INFO_MINE 
!
      INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: SHIFT_INFO_CHILDREN
!
      REAL(kind=KFPT),POINTER :: CENTERS_DISTANCE                       &
                                ,DLM                                    &
                                ,DPH                                    &
                                ,DYH                                    &
                                ,PDTOP                                  &
                                ,PT                                     &
                                ,SB_1                                   &
                                ,WB_1                                   &
                                ,TPH0_1                                 &
                                ,TLM0_1                                 &
                                ,RECIP_DPH_1                            &
                                ,RECIP_DLM_1                            &
                                ,RECIP_PARENT_SPACE_RATIO
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: DT_DOMAIN                 &
                                             ,DXH                       &
                                             ,DSG2                      &
                                             ,PDSG1                     &
                                             ,PSGML1                    &
                                             ,SG1                       &
                                             ,SG2                       &
                                             ,SGML2
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: CHILD_2WAY_WGT            &
                                             ,CHILD_PARENT_SPACE_RATIO
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: BOUND_1D_SOUTH_H          &
                                             ,BOUND_1D_SOUTH_V          &
                                             ,BOUND_1D_NORTH_H          &
                                             ,BOUND_1D_NORTH_V          &
                                             ,BOUND_1D_WEST_H           &
                                             ,BOUND_1D_WEST_V           &
                                             ,BOUND_1D_EAST_H           &
                                             ,BOUND_1D_EAST_V
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: FIS                     &
                                               ,FIS_CHILD_ON_PARENT     &
                                               ,GLAT                    &
                                               ,GLON                    &
                                               ,PD                      &
                                               ,SM                      &
                                               ,U10                     &
                                               ,V10
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: PDB_S                   &
                                               ,PDB_N                   &
                                               ,PDB_W                   &
                                               ,PDB_E
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: CW                    &
                                                 ,PINT                  &
                                                 ,Q                     &
                                                 ,T                     &
                                                 ,U                     &
                                                 ,V                     &
                                                 ,Z
!
      REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: TRACERS
!
      CHARACTER(len=6),DIMENSION(:),POINTER,SAVE :: STATIC_OR_MOVING     
!
      LOGICAL(kind=KLOG),POINTER :: CALLED_CHILD_2WAY_BOOKKEEPING
      LOGICAL(kind=KLOG),POINTER :: CHILD_FORCES_MY_SHIFT
      LOGICAL(kind=KLOG),POINTER :: FIRST_CALL_RECV_2WAY
      LOGICAL(kind=KLOG),POINTER :: FIRST_CALL_RECV_BC
      LOGICAL(kind=KLOG),POINTER :: FORCED_PARENT_SHIFT
      LOGICAL(kind=KLOG),POINTER :: I_AM_ACTIVE
      LOGICAL(kind=KLOG),POINTER :: I_AM_LEAD_FCST_TASK
      LOGICAL(kind=KLOG),POINTER :: I_WANT_TO_MOVE
      LOGICAL(kind=KLOG),POINTER :: MOVE_FLAG_SENT
      LOGICAL(kind=KLOG),POINTER :: MY_PARENT_MOVES
      LOGICAL(kind=KLOG),POINTER :: PARENT_WANTS_TO_MOVE
      LOGICAL(kind=KLOG),POINTER :: STOP_MY_MOTION
!
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: CALLED_PARENT_2WAY_BOOKKEEPING
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: CHILD_ACTIVE
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: MOVE_FLAG
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: SEND_CHILD_DATA
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: SIGNAL_2WAY_SEND_READY
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: SKIP_2WAY_UPDATE
!
      TYPE(INTEGER_DATA),DIMENSION(:),POINTER :: I_2WAY_UPDATE          &
                                                ,J_2WAY_UPDATE          &
                                                ,I_2WAY_H               &
                                                ,J_2WAY_H               &
                                                ,I_2WAY_V               &
                                                ,J_2WAY_V
!
      TYPE(INTEGER_DATA_TASKS),DIMENSION(:),POINTER :: WORDS_BOUND_H_SOUTH   &
                                                      ,WORDS_BOUND_H_NORTH   &
                                                      ,WORDS_BOUND_H_WEST    &
                                                      ,WORDS_BOUND_H_EAST    &
                                                      ,WORDS_BOUND_V_SOUTH   &
                                                      ,WORDS_BOUND_V_NORTH   &
                                                      ,WORDS_BOUND_V_WEST    &
                                                      ,WORDS_BOUND_V_EAST 
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER :: UPDATE_PARENT_2WAY
!
      TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: CHILD_SFC_ON_PARENT
      TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: NEST_FIS_ON_PARENT
      TYPE(REAL_DATA_2D),DIMENSION(:),POINTER :: NEST_FIS_V_ON_PARENT
!
      TYPE(REAL_DATA_TASKS),DIMENSION(:),POINTER :: PD_B_SOUTH          &
                                                   ,PD_B_NORTH          &
                                                   ,PD_B_WEST           &
                                                   ,PD_B_EAST           &
!
                                                   ,PD_B_SOUTH_V        &
                                                   ,PD_B_NORTH_V        &
                                                   ,PD_B_WEST_V         &
                                                   ,PD_B_EAST_V         &
!
                                                   ,FIS_CHILD_SOUTH     &
                                                   ,FIS_CHILD_NORTH     &
                                                   ,FIS_CHILD_WEST      &
                                                   ,FIS_CHILD_EAST
!
      TYPE(REAL_DATA_TASKS),DIMENSION(:,:),POINTER :: CHILD_BOUND_H_SOUTH &
                                                     ,CHILD_BOUND_H_NORTH &
                                                     ,CHILD_BOUND_H_WEST  &
                                                     ,CHILD_BOUND_H_EAST  &
                                                     ,CHILD_BOUND_V_SOUTH &
                                                     ,CHILD_BOUND_V_NORTH &
                                                     ,CHILD_BOUND_V_WEST  &
                                                     ,CHILD_BOUND_V_EAST
!
      TYPE(BC_H),POINTER :: MY_BC_VARS_H_S                     &
                           ,MY_BC_VARS_H_N                     &
                           ,MY_BC_VARS_H_W                     &
                           ,MY_BC_VARS_H_E                              
!
      TYPE(BC_V),POINTER :: MY_BC_VARS_V_S                     &
                           ,MY_BC_VARS_V_N                     &
                           ,MY_BC_VARS_V_W                     &
                           ,MY_BC_VARS_V_E 
!
      TYPE(MIXED_DATA_TASKS),DIMENSION(:),POINTER :: MOVING_CHILD_UPDATE
!
      TYPE(MULTIDATA),DIMENSION(:),POINTER :: BND_VAR_H_SOUTH  &
                                             ,BND_VAR_H_NORTH  &
                                             ,BND_VAR_H_WEST   &
                                             ,BND_VAR_H_EAST   &
                                             ,BND_VAR_V_SOUTH  &
                                             ,BND_VAR_V_NORTH  &
                                             ,BND_VAR_V_WEST   &
                                             ,BND_VAR_V_EAST
!
      TYPE(BNDS_2D),DIMENSION(:),POINTER :: NEST_FIS_ON_PARENT_BNDS
!
      TYPE(SIDES_0D),POINTER :: INDX_MAX_H,INDX_MAX_V
      TYPE(SIDES_0D),POINTER :: INDX_MIN_H,INDX_MIN_V
      TYPE(SIDES_0D),POINTER :: NUM_PARENT_TASKS_SENDING_H
      TYPE(SIDES_0D),POINTER :: NUM_PARENT_TASKS_SENDING_V
!
      TYPE(SIDES_2D),DIMENSION(:),POINTER :: CHILDTASK_BNDRY_H_RANKS
      TYPE(SIDES_2D),DIMENSION(:),POINTER :: CHILDTASK_BNDRY_V_RANKS
!
      TYPE(SAVE_TASK_IJ),DIMENSION(:),POINTER :: CHILDTASK_H_SAVE
      TYPE(SAVE_TASK_IJ),DIMENSION(:),POINTER :: CHILDTASK_V_SAVE
!
      TYPE(PARENT_POINTS_SURROUND_H),DIMENSION(:),POINTER :: PARENT_4_INDICES_H
      TYPE(PARENT_POINTS_SURROUND_V),DIMENSION(:),POINTER :: PARENT_4_INDICES_V
!
      TYPE(PARENT_WEIGHTS_SURROUND_H),DIMENSION(:),POINTER :: PARENT_4_WEIGHTS_H
      TYPE(PARENT_WEIGHTS_SURROUND_V),DIMENSION(:),POINTER :: PARENT_4_WEIGHTS_V
!
      TYPE(PARENT_DATA),DIMENSION(:),POINTER :: PARENT_TASK
!
      TYPE(CHILD_UPDATE_LINK),DIMENSION(:),POINTER :: TASK_UPDATE_SPECS &
                                                     ,CHILD_TASKS_2WAY_UPDATE
!
      TYPE(HANDLE_SEND),DIMENSION(:),POINTER :: HANDLE_MOVE_DATA  
!
      TYPE(HANDLE_SEND),DIMENSION(:,:),POINTER :: HANDLE_H_SOUTH        &
                                                 ,HANDLE_H_NORTH        &
                                                 ,HANDLE_H_WEST         &
                                                 ,HANDLE_H_EAST         &
                                                 ,HANDLE_V_SOUTH        &
                                                 ,HANDLE_V_NORTH        &
                                                 ,HANDLE_V_WEST         &
                                                 ,HANDLE_V_EAST
!
      TYPE(ESMF_Config),POINTER :: CF_MINE   
      TYPE(ESMF_Config),POINTER :: CF_PARENT
      TYPE(ESMF_Config),DIMENSION(:),POINTER :: CF
!
      TYPE(ESMF_FieldBundle),POINTER :: BUNDLE_2WAY                     &
                                       ,BUNDLE_NESTBC                   &
                                       ,MOVE_BUNDLE_H                   &
                                       ,MOVE_BUNDLE_V
!
      LOGICAL(kind=KLOG),POINTER :: ALLCLEAR_SIGNAL_PRESENT             &
                                   ,I_AM_A_FCST_TASK                    &
                                   ,I_AM_A_PARENT                       &
                                   ,MY_DOMAIN_MOVES                     &
                                   ,RECV_ALL_CHILD_DATA
!
      REAL(kind=KDBL),POINTER :: cpl1_prelim_tim                        &
                                ,cpl1_south_h_tim,cpl1_south_v_tim      &
                                ,cpl1_north_h_tim,cpl1_north_v_tim      &
                                ,cpl1_west_h_tim, cpl1_west_v_tim       &
                                ,cpl1_east_h_tim, cpl1_east_v_tim       &
                                ,cpl1_recv_tim
!
      REAL(kind=KDBL),POINTER :: cpl1_south_h_recv_tim                  &
                                ,cpl1_south_h_undo_tim                  &
                                ,cpl1_south_h_exp_tim                   &
                                ,cpl1_south_v_recv_tim                  &
                                ,cpl1_south_v_undo_tim                  &
                                ,cpl1_south_v_exp_tim
!
      REAL(kind=KDBL),POINTER :: cpl2_comp_tim                          &
                                ,cpl2_send_tim                          &
                                ,cpl2_wait_tim
!
      REAL(kind=KDBL),POINTER :: moving_nest_bookkeep_tim               &
                                ,moving_nest_update_tim
!
      REAL(kind=KDBL),POINTER :: parent_bookkeep_moving_tim             &
                                ,parent_update_moving_tim               &
                                ,t0_recv_move_tim                       &
                                ,read_moving_child_topo_tim             &
                                ,barrier_move_tim,pscd_tim,pscd1_tim    &
                                ,pscd2_tim,pscd3_tim,pscd4_tim

      REAL(kind=KDBL),POINTER :: ja1_tim,ja2_tim,ja3_tim,ja4_tim,jat_tim
!
!-----------------------------------------
!***  The following are for moving nests.
!-----------------------------------------
!
      CHARACTER(len=32),POINTER :: MOVE_TYPE
      INTEGER(kind=KINT),POINTER :: I_EAST_M,I_WEST_M                   &
                                   ,I_MAX,I_MIN                         &
                                   ,J_NORTH_M,J_SOUTH_M                 &
                                   ,J_MAX,J_MIN                         &
                                   ,NPTS_NS,NPTS_WE
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_PG,J_PG
!
      REAL(kind=KFPT),POINTER :: COEF
      REAL(kind=KFPT),POINTER :: ELAPSED_TIME_MIN
      REAL(kind=KFPT),POINTER :: RNPTS_HZ
!
      LOGICAL(kind=KLOG),POINTER :: FIRST_PASS_M
      LOGICAL(kind=KLOG),POINTER :: FIRST_STEP_2WAY
      LOGICAL(kind=KLOG),POINTER :: I_HOLD_CENTER_POINT
!
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: IN_WINDOW
      LOGICAL(kind=KLOG),DIMENSION(:),POINTER :: I_HOLD_PG_POINT
!
      INTEGER(kind=KINT),POINTER :: MOVE_INTERVAL_MINUTES
      INTEGER(kind=KINT),POINTER :: N_MOVES
      REAL(kind=KFPT),DIMENSION(:),POINTER :: MOVE_MINUTE
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: MOVE_I_SW,MOVE_J_SW
!
!-----------------------------------------------------------------------
!***  Quantities not associated with the composite object.
!-----------------------------------------------------------------------
!
      INTEGER(kind=KINT),PARAMETER :: INDX_SW=1                         &
                                     ,INDX_SE=2                         &
                                     ,INDX_NW=3                         &
                                     ,INDX_NE=4
!
      INTEGER(kind=KINT),SAVE :: MOVE_TAG=1111                          &  !<-- Arbitrary tag used for child's move
                                ,MOVING_BC_TAG=1112                     &  !<-- Arbitrary tag used for moving nests' BC updates
                                ,PARENT_SHIFT_TAG=1E6                      !<-- Arbitrary tag used for parent's move.
!
      INTEGER(kind=KINT),SAVE :: MAX_FORCED_SHIFT                          !<-- # parent points a child forces its parent to shift
!
      INTEGER(kind=KINT),SAVE :: CHILD_ID                               &
                                ,COMM_FCST_TASKS                        &
                                ,INDX_CW,INDX_Q                         &
                                ,INDX_WATER_END                         &
                                ,INDX_AERO_START                        &
                                ,INDX_GAS_END                           &
                                ,NHOURS_FCST                            &
                                ,NLEV_2WAY                              &
                                ,NROWS_P_UPD_E                          &
                                ,NROWS_P_UPD_N                          &
                                ,NROWS_P_UPD_S                          &
                                ,NROWS_P_UPD_W                          &
                                ,NUM_FIELDS_MOVE                        &
                                ,NUM_FIELDS_MOVE_2D_H_I                 &
                                ,NUM_FIELDS_MOVE_2D_X_I                 &
                                ,NUM_FIELDS_MOVE_2D_H_R                 &
                                ,NUM_FIELDS_MOVE_2D_X_R                 &
                                ,NUM_FIELDS_MOVE_3D_H                   &
                                ,NUM_FIELDS_MOVE_2D_V                   &
                                ,NUM_FIELDS_MOVE_3D_V                   &
                                ,NVARS_2WAY_UPDATE                      &
                                ,NVARS_NESTBC                           & 
                                ,NVARS_NESTBC_H                         & 
                                ,NVARS_NESTBC_V
!
      INTEGER(kind=KINT) :: TWOWAY_SIGNAL_TAG                              !<-- Arbitrary tag used for 2way exchange
!
      INTEGER(kind=KINT),DIMENSION(:),ALLOCATABLE,SAVE :: NBASE_VAR_H   &
                                                         ,NBASE_VAR_V
!
      REAL(kind=KDBL),SAVE :: HYPER_A
!
      REAL(kind=KFPT),SAVE :: EPS=1.E-4                                 &
                             ,MIN_DIST_PARENT                              !<-- # of parent gridpoints a child can be from parent
!
      REAL(kind=KFPT),SAVE :: NORTH_LAT_MAX_MVG_NEST                    &  !<-- Do not let nests move north of this latitude (rad)
                             ,SOUTH_LAT_MAX_MVG_NEST                       !<-- Do not let nests move south of this latitude (rad)
!
      REAL(kind=KDBL) :: btim,btim0,btim1,btim2
!
      CHARACTER(len=5),SAVE :: NEST_MODE                                   !<--- Is the nesting 1-way or 2-way
!
      CHARACTER(len=99) :: CONFIG_FILE_NAME
!
      LOGICAL(kind=KLOG) :: FREE_FORECAST,DIG_FILTER
!
      LOGICAL(kind=KLOG),SAVE :: GLOBAL_TOP_PARENT                      &  !<-- Is the uppermost parent global?
                                ,RESTART                                   !<-- Is this a restarted run?
!
      TYPE(ESMF_Config),SAVE :: CF_1                                       !<-- Domain #1's configure object
!
      integer(kind=kint),dimension(8) :: values
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_CPL_REGISTER(CPL_COMP,RC_NEST_REG)
!
!-----------------------------------------------------------------------
!***  Register the nesting coupler component's Initialize, Run, and 
!***  Finalize routines.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                      !<-- Coupler component
!
      INTEGER(kind=KINT),INTENT(OUT) :: RC_NEST_REG                                   !<-- Return code for register
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: RC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RC         =ESMF_SUCCESS
      RC_NEST_REG=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  Register the various pieces of the Parent-Child coupler component.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 1 of the P-C Coupler Initialize"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_INITIALIZE             &  !<-- subroutineType
                                    ,PARENT_CHILD_CPL_INITIALIZE0       &  !<-- User's subroutineName
                                    ,phase=1                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 2 of the P-C Coupler Initialize"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_INITIALIZE             &  !<-- subroutineType
                                    ,PARENT_CHILD_CPL_INITIALIZE1       &  !<-- User's subroutineName
                                    ,phase=2                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 3 of the P-C Coupler Initialize"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_INITIALIZE             &  !<-- subroutineType
                                    ,PARENT_CHILD_CPL_INITIALIZE2       &  !<-- User's subroutineName
                                    ,phase=3                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Register the Parent-Child coupler's Run subroutines.
!
!     The Parent-Child Run step of the coupler has five distinct parts:
!     (1) Check for signals related to 2-way exchange at the beginning
!         of timesteps to determine if the execution should proceed
!         into the timestep or drop out.  This is only relevant for
!         generational task assignment (i.e., for 2-way nesting).
!     (2) At the start of parent timesteps a child receives BC data
!         from its parent.
!     (3) If using 2-way nesting then parents receive exchange data
!         from their children at the start of every parent timestep.
!     (4) At the end of every parent timestep a parent sends BC data 
!         to its children.  For those children that moved, the parent
!         must first generate new interpolation information and then
!         compute the new internal shift data for those nests. 
!     (5) Finally any 2-way children send exchange data to their
!         parents at the end of every parent timestep.
!
!***  Thus register the coupler's Run step with those two phases.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 1 of P-C Coupler Run"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_RUN                    &  !<-- subroutineType
                                    ,CHECK_2WAY_SIGNALS                 &  !<-- User's subroutineName
                                    ,phase=1                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 2 of P-C Coupler Run"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_RUN                    &  !<-- subroutineType
                                    ,CHILDREN_RECV_PARENT_DATA          &  !<-- User's subroutineName
                                    ,phase=2                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 3 of P-C Coupler Run"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_RUN                    &  !<-- subroutineType
                                    ,PARENTS_RECV_CHILD_2WAY_DATA       &  !<-- User's subroutineName
                                    ,phase=3                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 4 of P-C Coupler Run"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_RUN                    &  !<-- subroutineType
                                    ,PARENTS_SEND_CHILD_DATA            &  !<-- User's subroutineName
                                    ,phase=4                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Phase 5 of P-C Coupler Run"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_RUN                    &  !<-- subroutineType
                                    ,CHILDREN_SEND_PARENTS_2WAY_DATA    &  !<-- User's subroutineName
                                    ,phase=5                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Register the coupler Finalize subroutine.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set Entry Point for Nesting Coupler Finalize"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CplCompSetEntryPoint(CPL_COMP                           &  !<-- The Parent-Child Coupler Component
                                    ,ESMF_METHOD_FINALIZE               &  !<-- subroutineType
                                    ,PARENT_CHILD_CPL_FINALIZE          &  !<-- User's subroutineName
                                    ,phase=1                            &
                                    ,rc=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NEST_REG)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Check the error signal variable.
!-----------------------------------------------------------------------
!
      IF(RC_NEST_REG==ESMF_SUCCESS)THEN
!       WRITE(0,*)" NESTING COUPLER REGISTER SUCCEEDED"
      ELSE
        WRITE(0,*)" NESTING COUPLER REGISTER FAILED"
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_CPL_REGISTER
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_CPL_INITIALIZE0(CPL_COMP                  &
                                             ,IMP_STATE                 &
                                             ,EXP_STATE                 &
                                             ,CLOCK                     &
                                             ,RC_FINAL)   
!
!-----------------------------------------------------------------------
!***  This preliminary routine is used only for runs containing nests.
!***  It serves primarily to allow children to send their SW corner
!***  location to their parents.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: CHILDTASK_0,CONFIG_ID,HANDLE_X,ID_CHILD     &
                           ,MAX_DOMAINS,MY_DOMAIN_ID,MYPE_X,N,NTAG
!
      INTEGER(kind=KINT) :: IERR,ISTAT,RC,RC_CPL_INIT
!
      CHARACTER(len=2) :: INT_TO_CHAR
      CHARACTER(len=6) :: FMT='(I2.2)'
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC         =ESMF_SUCCESS
      RC_FINAL   =ESMF_SUCCESS
      RC_CPL_INIT=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  What is this domain's ID?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init1: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)                                      !<-- Use dummy for shorter reference to composite
!
!-----------------------------------------------------------------------
!
!------------------------
!***  Number of Children
!------------------------
!
      NUM_CHILDREN=>cc%NUM_CHILDREN
      NUM_CHILDREN=0
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Number of Children on This Domain"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='NUM_CHILDREN'                       &  !<-- Name of the attribute to extract
                            ,value=NUM_CHILDREN                         &  !<-- # of this domain's children
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------
!***  Maximum number of domains
!-------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Maximum Number of Domains"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MAX_DOMAINS'                        &  !<-- Name of the attribute to extract
                            ,value=MAX_DOMAINS                          &  !<-- Maximum # of domains
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------
!***  Child-to-Parent Communicator
!----------------------------------
!
      COMM_TO_MY_PARENT=>CC%COMM_TO_MY_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Child-to-Parent Comm in P-C Coupler Init1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Child-to-Parent Comm'               &  !<-- Name of the attribute to extract
                            ,value=COMM_TO_MY_PARENT                    &  !<-- MPI communicator to my parent
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------
!***  The association of domains and their configure files.
!-----------------------------------------------------------
!
      IF(.NOT.ASSOCIATED(DOMAIN_ID_TO_RANK))THEN
        ALLOCATE(DOMAIN_ID_TO_RANK(1:MAX_DOMAINS))
      ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Association of Domains and Config Files"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='DOMAIN_ID_TO_RANK'              &  !<-- Name of the attribute to extract
                            ,itemCount=MAX_DOMAINS                      &  !<-- Name of elements in the Attribute
                            ,valueList=DOMAIN_ID_TO_RANK                &  !<-- Array associating domains and config files
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------
!***  Intracommunicator for fcst tasks on each domain
!-----------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Fcst Task Intracomm in P-C Coupler Init0"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Intracommunicator for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      I_AM_LEAD_FCST_TASK=>cc%I_AM_LEAD_FCST_TASK
      I_AM_LEAD_FCST_TASK=.FALSE.
!
      IF(I_AM_A_FCST_TASK)THEN
!
        CALL MPI_COMM_RANK(COMM_FCST_TASKS,MYPE_X,IERR)
!
        IF(MYPE_X==0)THEN
          I_AM_LEAD_FCST_TASK=.TRUE.
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Tasks load their domain's configure file.
!-----------------------------------------------------------------------
!
      CONFIG_ID=DOMAIN_ID_TO_RANK(MY_DOMAIN_ID)
      WRITE(INT_TO_CHAR,FMT)CONFIG_ID
      CONFIG_FILE_NAME='configure_file_'//INT_TO_CHAR                      !<-- Prepare the config file name
!
      cc%CF_MINE=ESMF_ConfigCreate(rc=RC)
      CF_MINE=>cc%CF_MINE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Parent-Child Init: Nest Loads Its Configure File"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigLoadFile(config  =CF_MINE                         &
                              ,filename=CONFIG_FILE_NAME                &
                              ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Parent tasks must know the communicators to their children
!***  and their domain IDs.
!-----------------------------------------------------------------------
!
      IF(I_AM_A_FCST_TASK.AND.NUM_CHILDREN>0)THEN                          !<-- Select parent fcst tasks for additional setup
!
        ALLOCATE(cc%COMM_TO_MY_CHILDREN(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%COMM_TO_MY_CHILDREN stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        COMM_TO_MY_CHILDREN=>cc%COMM_TO_MY_CHILDREN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init0: Extract Parent-to-Child Comm in Coupler"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =IMP_STATE                      &  !<-- The parent-child coupler import state
                              ,name     ='Parent-to-Child Comms'        &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of items in the Attribute
                              ,valueList=COMM_TO_MY_CHILDREN            &  !<-- MPI communicators to my children
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------
!***  The IDs of the Children
!-----------------------------
!
        ALLOCATE(CC%MY_CHILDREN_ID(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%MY_CHILDREN_ID stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
!
        MY_CHILDREN_ID=>cc%MY_CHILDREN_ID
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init0: Extract IDs of Children"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =IMP_STATE                      &  !<-- The parent-child coupler import state
                              ,name     ='CHILD_IDs'                    &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of items in the Attribute
                              ,valueList=MY_CHILDREN_ID                 &  !<-- The domain IDs of the current domain's children
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Is this a restarted run?
!-----------------------------------------------------------------------
!
      I_AM_A_FCST_TASK=>cc%I_AM_A_FCST_TASK
!
      RESTART=.FALSE.
!
      IF(I_AM_A_FCST_TASK)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init0: Extract Restart Flag from P-C Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='RESTART'                          &  !<-- Name of the attribute to extract
                              ,value=RESTART                            &  !<-- The restart flag (true or false)
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  The children get the location of their SW corner. 
!***  That information was exported from the Domain component. 
!-----------------------------------------------------------------------
!
      child_block_0: IF(MY_DOMAIN_ID>1)THEN                                 !<-- Select the children
!
        I_SW_PARENT_CURRENT=>cc%I_SW_PARENT_CURRENT
        J_SW_PARENT_CURRENT=>cc%J_SW_PARENT_CURRENT
        LAST_STEP_MOVED=>cc%LAST_STEP_MOVED
!
        IF(I_AM_A_FCST_TASK)THEN
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Gets SW Corner from Import State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state=IMP_STATE                        &  !<-- The parent-child coupler import state
                                ,name ='I_PAR_STA'                      &  !<-- Name of Attribute to extract
                                ,value=I_SW_PARENT_CURRENT              &  !<-- Put the extracted Attribute here
                                ,rc   =RC)
!
          CALL ESMF_AttributeGet(state=IMP_STATE                        &  !<-- The parent-child coupler import state
                                ,name ='J_PAR_STA'                      &  !<-- Name of Attribute to extract
                                ,value=J_SW_PARENT_CURRENT              &  !<-- Put the extracted Attribute here
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Get Last Move Timestep from Import State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state=IMP_STATE                        &  !<-- The parent-child coupler import state
                                ,name ='LAST_STEP_MOVED'                &  !<-- Name of Attribute to extract
                                ,value=LAST_STEP_MOVED                  &  !<-- Put the extracted Attribute here
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Fill the domain's next move timestep.  The value is a dummy if 
!***  it is not relevant.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Get Next Move Timestep from Import State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state=IMP_STATE                        &  !<-- The parent-child coupler import state
                                ,name ='NEXT_MOVE_TIMESTEP'             &  !<-- Name of Attribute to extract
                                ,value=cc%NEXT_MOVE_TIMESTEP            &  !<-- Put the extracted Attribute here
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  The lead child task ISends its parent's lead task the child
!***  domain's SW corner location.  There is no need for a Wait
!***  since a task will only ever execute this send one time.
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
!
          NTAG=12121+100*MY_DOMAIN_ID                                      !<-- Use a unique tag dependent on the domain ID
!
          CALL MPI_ISSEND(I_SW_PARENT_CURRENT                           &  !<-- Parent I of SW corner of nest domain
                         ,1                                             &  !<-- There is 1 word
                         ,MPI_INTEGER                                   &  !<-- The message is an integer
                         ,0                                             &  !<-- Send to lead parent task (always 0 in intracomm)
                         ,NTAG                                          &  !<-- Unique MPI tag
                         ,COMM_TO_MY_PARENT                             &  !<-- MPI intracommunicator to the parent
                         ,HANDLE_X                                      &  !<-- Request handle for this ISend
                         ,IERR )
!
          NTAG=12122+100*MY_DOMAIN_ID                                      !<-- Use a unique tag dependent on the domain ID
!
          CALL MPI_ISSEND(J_SW_PARENT_CURRENT                           &  !<-- Parent J of SW corner of nest domain
                         ,1                                             &  !<-- There is 1 word
                         ,MPI_INTEGER                                   &  !<-- The message is an integer
                         ,0                                             &  !<-- Send to lead parent task (always 0 in intracomm)
                         ,NTAG                                          &  !<-- Unique MPI tag
                         ,COMM_TO_MY_PARENT                             &  !<-- MPI intracommunicator to the parent
                         ,HANDLE_X                                      &  !<-- Request handle for this ISend
                         ,IERR )
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF child_block_0
!
!-----------------------------------------------------------------------
!***  Parents receive their children's SW corner locations.
!-----------------------------------------------------------------------
!
      parent_block_0: IF(NUM_CHILDREN>0)THEN                               !<-- Select the parents
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%I_PARENT_SW(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%I_PARENT_SW stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
!
        ALLOCATE(cc%J_PARENT_SW(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%J_PARENT_SW stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
!
!
        I_PARENT_SW=>cc%I_PARENT_SW
        J_PARENT_SW=>cc%J_PARENT_SW
!
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
!
          DO N=1,NUM_CHILDREN
!
            CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(0)      !<-- Local rank of child's lead task in P-C communicator
            ID_CHILD=MY_CHILDREN_ID(N)                                     !<-- Domain ID of child N
            NTAG=12121+100*MY_CHILDREN_ID(N)
!
            CALL MPI_IRECV(I_PARENT_SW(N)                               &  !<-- Parent I of SW corner of child N
                          ,1                                            &  !<-- There is 1 word
                          ,MPI_INTEGER                                  &  !<-- The word is an integer
                          ,CHILDTASK_0                                  &  !<-- The Child task who sent
                          ,NTAG                                         &  !<-- Unique MPI tag
                          ,COMM_TO_MY_CHILDREN(N)                       &  !<-- MPI communicator between parent and child N
                          ,HANDLE_I_SW(ID_CHILD)                        &  !<-- Request handle for IRecv from child N
                          ,IERR ) 
!
            NTAG=12122+100*MY_CHILDREN_ID(N)
!
            CALL MPI_IRECV(J_PARENT_SW(N)                               &  !<-- Parent J of SW corner of child N
                          ,1                                            &  !<-- There is 1 word
                          ,MPI_INTEGER                                  &  !<-- The word is an integer
                          ,CHILDTASK_0                                  &  !<-- The Child task who sent
                          ,NTAG                                         &  !<-- Unique MPI tag
                          ,COMM_TO_MY_CHILDREN(N)                       &  !<-- MPI communicator between parent and child N
                          ,HANDLE_J_SW(ID_CHILD)                        &  !<-- Request handle for IRecv from child N
                          ,IERR )
!
          ENDDO
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF parent_block_0
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_CPL_INITIALIZE0
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_CPL_INITIALIZE1(CPL_COMP                  &
                                             ,IMP_STATE                 &
                                             ,EXP_STATE                 &
                                             ,CLOCK                     &
                                             ,RC_FINAL)   
!
!-----------------------------------------------------------------------
!***  Perform initial work needed by the Parent-Child coupler.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT),SAVE :: N8=8
!
      INTEGER(kind=KINT) :: I,J,L
!
      INTEGER(kind=KINT) :: CHILD_FILTER,CHILDTASK_0,CONFIG_ID          &
                           ,H_OR_V_INT,HANDLE_X,ID_CHILD,ID_DOM         &
                           ,IDIM,IEND,ISTART,IUNIT_FIS_NEST             &
                           ,JCORNER,JDIM,JEND,JSTART,JSTOP              &
                           ,KOUNT                                       &
                           ,LENGTH,LIM1_H,LIM1_V,LIM2_H,LIM2_V,LMP1,LOR &
                           ,MAX_DOMAINS,MY_DOMAIN_ID,MY_PARENT_ID       &
                           ,MYPE_X                                      &
                           ,N,N1,N2,N3,NN                               &
                           ,N_CHILD,N_FIELD,N_START,N_END               &
                           ,N_H_EAST_WEST,N_H_NORTH_SOUTH               &
                           ,N_V_EAST_WEST,N_V_NORTH_SOUTH               &
                           ,NKOUNT,NTAG,NTIMESTEP                       &
                           ,NUM_BOUNDARY_WORDS                          &
                           ,NUM_DOMAINS,NUM_TASKS_TOTAL                 &
                           ,NUM_WORDS,NV
!
      INTEGER(kind=KINT) :: IERR,ISTAT,RC,RC_CPL_INIT
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER(kind=KINT),DIMENSION(1:3) :: INFO_EXT_DATA
!
      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      REAL(kind=KFPT) :: CONST1,CONST2,CONST3,CONST4                    &
                        ,DIST_NESTV_SOUTH_TO_PARENTV_SOUTH              &
                        ,DT_PARENT                                      &
                        ,GRID_DIST_KM                                   &
                        ,REAL_I                                         &
                        ,REAL_J
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: ARRAY_R3D
!
      REAL(kind=DOUBLE) :: D2R,D_ONE,D_180,PI
!
      CHARACTER(len=2) :: INT_TO_CHAR
      CHARACTER(len=6) :: FMT='(I2.2)'
      CHARACTER(len=5),DIMENSION(:),ALLOCATABLE :: NEST_MODE_CHILD
      CHARACTER(len=19) :: PRESCRIBED_FILENAME
      CHARACTER(len=99) :: FIELD_NAME
!
      LOGICAL(kind=KLOG) :: DOMAIN_MOVES,OPENED
!
      TYPE(COMPOSITE),POINTER :: CC                                     
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC         =ESMF_SUCCESS
      RC_FINAL   =ESMF_SUCCESS
      RC_CPL_INIT=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  What is this domain's ID?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init1: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)                                      !<-- Use dummy for shorter reference to composite
!
!-----------------------------------------------------------------------
!***  What is the total number of domains in this run?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Total Number of Domains in P-C Coupler Init"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='NUM_DOMAINS'                        &  !<-- Name of the attribute to extract
                            ,value=NUM_DOMAINS                          &  !<-- Total number of domains
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  What is the total # of tasks on each domain?
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%NTASKS_DOMAIN(1:NUM_DOMAINS),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%NTASKS_DOMAIN stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      NTASKS_DOMAIN=>cc%NTASKS_DOMAIN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Total # of Tasks on Each Domain in P-C Coupler Init"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='NTASKS_DOMAIN'                  &  !<-- Name of the attribute to extract
                            ,itemCount=NUM_DOMAINS                      &  !<-- # of items in the Attribute
                            ,valueList=NTASKS_DOMAIN                    &  !<-- # of fcst+quilt tasks on each domain
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  How many forecast tasks on each domain?
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%FTASKS_DOMAIN(1:NUM_DOMAINS),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%FTASKS_DOMAIN stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      FTASKS_DOMAIN=>cc%FTASKS_DOMAIN
!
      I_AM_A_FCST_TASK=>cc%I_AM_A_FCST_TASK
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Number of Fcst Tasks on Each Domain in P-C Coupler Init"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='FTASKS_DOMAIN'                  &  !<-- Name of the attribute to extract
                            ,itemCount=NUM_DOMAINS                      &  !<-- # of items in the Attribute
                            ,valueList=FTASKS_DOMAIN                    &  !<-- # of forecast tasks on each domain
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------------------
!***  Children sending 2-way data to parent
!-------------------------------------------
!
      NUM_2WAY_CHILDREN=>cc%NUM_2WAY_CHILDREN
      NUM_2WAY_CHILDREN=0
!
!--------------------------------
!***  Motion and moving children
!--------------------------------
!
      NUM_MOVING_CHILDREN=>cc%NUM_MOVING_CHILDREN
      NUM_MOVING_CHILDREN=0
!
      MY_DOMAIN_MOVES=>cc%MY_DOMAIN_MOVES
      MY_DOMAIN_MOVES=.FALSE.
!
!---------------------------
!***  Domain IDs of Parents
!---------------------------
!
      ALLOCATE(cc%ID_PARENTS(1:NUM_DOMAINS),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%ID_PARENTS stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      ID_PARENTS=>cc%ID_PARENTS
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Domain IDs of Parents in Init Step Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='ID_PARENTS'                     &  !<-- Name of the attribute to extract
                            ,itemCount=NUM_DOMAINS                      &  !<-- # of items in the Attribute
                            ,valueList=ID_PARENTS                       &  !<-- Domain IDs of parents
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------------------------------
!***  Number of forecast tasks on this domain's parent
!------------------------------------------------------
!
      MY_PARENT_ID=ID_PARENTS(MY_DOMAIN_ID)                                !<-- Domain ID of the current domain's parent
!
      NUM_TASKS_PARENT     =>cc%NUM_TASKS_PARENT
      NUM_FCST_TASKS_PARENT=>cc%NUM_FCST_TASKS_PARENT
!
      IF(MY_PARENT_ID>0)THEN
        NUM_TASKS_PARENT     =NTASKS_DOMAIN(MY_PARENT_ID)                  !<-- Total # of fcst+quilt tasks on the parent's domain
        NUM_FCST_TASKS_PARENT=FTASKS_DOMAIN(MY_PARENT_ID)                  !<-- # of forecast tasks on the parent's domain
      ELSE
        NUM_TASKS_PARENT=0                                                 !<-- Uppermost parent has no parent
        NUM_FCST_TASKS_PARENT=0                                            !<-- Uppermost parent has no parent
      ENDIF
!
!-------------------------------------------------------------
!***  Task's local rank in its Parent-Child Intracommunicator
!-------------------------------------------------------------
!
      MYPE=>CC%MYPE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Task Rank in Domain Component"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MYPE_DOMAIN'                        &  !<-- Name of the attribute to extract
                            ,value=MYPE                                 &  !<-- Rank of task in Parent-Child intracomm
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------
!***  Intracommunicator for fcst tasks on each domain
!-----------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Fcst Task Intracomm in P-C Coupler Init1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Intracommunicator for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------
!***  Number of fcst tasks on this domain
!-----------------------------------------
!
      NUM_PES_FCST=>CC%NUM_PES_FCST
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract # of Forecast Tasks in P-C Coupler Init1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='NUM_PES_FCST'                       &  !<-- Name of the attribute to extract
                            ,value=NUM_PES_FCST                         &  !<-- MPI communicator for this domain
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------
!***  Fundamental Timestep on Each Domain
!-----------------------------------------
!
      ALLOCATE(cc%DT_DOMAIN(1:NUM_DOMAINS),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%DT_DOMAIN stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      DT_DOMAIN=>cc%DT_DOMAIN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Timestep of Domains in P-C Coupler Init1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='DOMAIN_DTs'                     &  !<-- Name of the attribute to extract
                            ,itemCount=NUM_DOMAINS                      &  !<-- # of items in the Attribute
                            ,valueList=DT_DOMAIN                        &  !<-- Timestep on each domain
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Parent tasks must know the communicators to their children.
!-----------------------------------------------------------------------
!
      IF(NUM_CHILDREN>0)THEN                                               !<-- Select parents for additional setup 
!
        ALLOCATE(cc%COMM_TO_MY_CHILDREN(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%COMM_TO_MY_CHILDREN stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        COMM_TO_MY_CHILDREN=>cc%COMM_TO_MY_CHILDREN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init1: Extract Parent-to-Child Comm in Coupler"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =IMP_STATE                      &  !<-- The parent-child coupler import state
                              ,name     ='Parent-to-Child Comms'        &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of items in the Attribute
                              ,valueList=COMM_TO_MY_CHILDREN            &  !<-- MPI communicators to my children
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Write/quilt tasks are excluded from the grid-specific information.
!-----------------------------------------------------------------------
!
      I_AM_A_FCST_TASK=>cc%I_AM_A_FCST_TASK
!
      IF(.NOT.I_AM_A_FCST_TASK)RETURN
!
!---------------------------------------------
!***  The Tasks' Subdomain Integration Limits
!---------------------------------------------
!
      ITS=>cc%ITS
      ITE=>cc%ITE
      JTS=>cc%JTS
      JTE=>cc%JTE
      LM =>cc%LM
!
      NHALO=>cc%NHALO
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Integration Subdomain Limits in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='ITS'                                &  !<-- Name of the attribute to extract
                            ,value=ITS                                  &  !<-- This task's integration limit: Starting I
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='ITE'                                &  !<-- Name of the attribute to extract
                            ,value=ITE                                  &  !<-- This task's integration limit: Ending I
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='JTS'                                &  !<-- Name of the attribute to extract
                            ,value=JTS                                  &  !<-- This task's integration limit: Starting J
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='JTE'                                &  !<-- Name of the attribute to extract
                            ,value=JTE                                  &  !<-- This task's integration limit: Ending J
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='LM'                                 &  !<-- Name of the attribute to extract
                            ,value=LM                                   &  !<-- This task's integration limit: # of layers in vertical
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='NHALO'                              &  !<-- Name of the attribute to extract
                            ,value=NHALO                                &  !<-- Width of the task subdomain haloes
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      IMS=>cc%IMS
      IME=>cc%IME
      JMS=>cc%JMS
      JME=>cc%JME
!
      IMS=ITS-NHALO
      IME=ITE+NHALO
      JMS=JTS-NHALO
      JME=JTE+NHALO
!
!-----------------------------------------------------
!***  Index Limits of All Forecast Tasks on My Domain
!-----------------------------------------------------
!
      ALLOCATE(cc%LOCAL_ISTART(1:FTASKS_DOMAIN(MY_DOMAIN_ID)),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate LOCAL_ISTART for MY_DOMAIN_ID=',MY_DOMAIN_ID,' stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      ALLOCATE(cc%LOCAL_IEND  (1:FTASKS_DOMAIN(MY_DOMAIN_ID)))
      ALLOCATE(cc%LOCAL_JSTART(1:FTASKS_DOMAIN(MY_DOMAIN_ID)))
      ALLOCATE(cc%LOCAL_JEND  (1:FTASKS_DOMAIN(MY_DOMAIN_ID)))
!
      LOCAL_ISTART=>cc%LOCAL_ISTART
      LOCAL_IEND  =>cc%LOCAL_IEND
      LOCAL_JSTART=>cc%LOCAL_JSTART
      LOCAL_JEND  =>cc%LOCAL_JEND
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Index Limits of Fcst Tasks on My Domain in Init Step Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='LOCAL ISTART'                   &  !<-- Name of the attribute to extract
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- # of items in the Attribute
                            ,valueList=LOCAL_ISTART                     &  !<-- Starting I's of fcst tasks on my domain
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='LOCAL IEND'                     &  !<-- Name of the attribute to extract
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- # of items in the Attribute
                            ,valueList=LOCAL_IEND                       &  !<-- Ending I's of fcst tasks on my domain
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='LOCAL JSTART'                   &  !<-- Name of the attribute to extract
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- # of items in the Attribute
                            ,valueList=LOCAL_JSTART                     &  !<-- Starting J's of fcst tasks on my domain
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='LOCAL JEND'                     &  !<-- Name of the attribute to extract
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- # of items in the Attribute
                            ,valueList=LOCAL_JEND                       &  !<-- Ending J's of fcst tasks on my domain
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------------
!***  The Full Domain Dimensions
!--------------------------------
!
      IDS=>cc%IDS
      IDE=>cc%IDE
      JDS=>cc%JDS
      JDE=>cc%JDE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Full Domain Dimensions in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='IDS'                                &  !<-- Name of the attribute to extract
                            ,value=IDS                                  &  !<-- This task's integration limit: Starting I
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='IDE'                                &  !<-- Name of the attribute to extract
                            ,value=IDE                                  &  !<-- This task's integration limit: Ending I
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='JDS'                                &  !<-- Name of the attribute to extract
                            ,value=JDS                                  &  !<-- This task's integration limit: Starting J
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='JDE'                                &  !<-- Name of the attribute to extract
                            ,value=JDE                                  &  !<-- This task's integration limit: Ending J
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------------------------
!***  The Widths of the Boundary Blending Region
!------------------------------------------------
!
      N_BLEND_H=>cc%N_BLEND_H
      N_BLEND_V=>cc%N_BLEND_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Widths of Bndry Blending Region in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='N_BLEND_H'                          &  !<-- Name of the attribute to extract
                            ,value=N_BLEND_H                            &  !<-- # of boundary blending rows for H points
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='N_BLEND_V'                          &  !<-- Name of the attribute to extract
                            ,value=N_BLEND_V                            &  !<-- # of boundary blending rows for V points
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      IF(N_BLEND_V>N_BLEND_H)THEN
        WRITE(0,*)' N_BLEND_V CANNOT EXCEED N_BLEND_H DUE TO PD AVERAGING!!!'
        WRITE(0,*)' ABORTING'
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
!--------------------------------------
!***  Each forecast task's 8 neighbors
!--------------------------------------
!
      MY_NEB=>cc%MY_NEB
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='MY_NEB'                         &  !<-- Name of the attribute to extract
                            ,itemCount=N8                               &  !<-- # of items in the Attribute
                            ,valueList=MY_NEB                           &  !<-- This task's eight neighbors
                            ,rc       =RC)
!
!------------------------------------
!***  The frequency of physics calls 
!------------------------------------
!
      NPHS=>cc%NPHS
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract NPHS in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='NPHS'                               &  !<-- Name of the attribute to extract
                            ,value=NPHS                                 &  !<-- The frequency of physics calls
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Unload some key prognostic data from the import state that are
!***  needed inside the Parent-Child coupler and point at those data
!***  (located in the Solver internal state) appropriate for the
!***  current domain.
!-----------------------------------------------------------------------
!
!--------
!***  PD
!--------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PD Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='PD'                                  &  !<-- Extract PD
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PD from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=PD                                   &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%PD=>PD
!
!-------------------------------
!***  Layer Interface Pressures
!-------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PINT from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='PINT'                                &  !<-- Extract layer interface pressures
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PINT from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=PINT                                 &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%PINT=>PINT
!
!-----------------
!***  Temperature
!-----------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract T Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='T'                                   &  !<-- Extract temperature
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)

!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract T from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=T                                    &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%T=>T
!
!------------
!***  U Wind
!------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract U Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='U'                                   &  !<-- Extract U wind
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract U from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=U                                    &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%U=>U
!
!------------
!***  V Wind
!------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract V Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='V'                                   &  !<-- Extract V wind
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract V from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=V                                    &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%V=>V
!
!----------------
!***  Modlayer Z
!----------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Midlayer Z Field from P-C Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='Z'                                   &  !<-- Extract midlayer Z
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Midlayer Z from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=Z                                    &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%Z=>Z
!
!----------------------------------
!***  10-m U component of the wind
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract 10-m U Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='U10'                                 &  !<-- Extract 10-m U wind component
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract 10-m U from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=U10                                  &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%U10=>U10
!
!----------------------------------
!***  10-m V component of the wind
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract 10-m V Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='V10'                                 &  !<-- Extract 10-m V wind component
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract 10-m V from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=V10                                  &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%V10=>V10
!
!-------------
!***  Tracers
!-------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Tracers Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='TRACERS'                             &  !<-- Extract tracers
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Tracers from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=TRACERS                              &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%TRACERS=>TRACERS
!
!----------------------
!***  Sfc Geopotential
!----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract FIS Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='FIS'                                 &  !<-- Extract sfc geopotential
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract FIS from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=FIS                                  &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%FIS=>FIS
!
!--------------
!***  Sea Mask
!--------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Sea Mask from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='SM'                                  &  !<-- Extract sea mask
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract SM from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=SM                                   &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%SM=>SM
!
!-------------------------
!***  Geographic latitude
!-------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLAT Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='GLAT'                                &  !<-- Extract geographic latitude
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLAT from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=cc%GLAT                              &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------
!***  Geographic longitude
!--------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLON Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='GLON'                                &  !<-- Extract geographic longitude
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLON from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=cc%GLON                              &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------------------
!***  PT,PDTOP,PSGML1,SG1,SG2,SGML2,DSG2,PDSG1
!----------------------------------------------
!
      PT=>cc%PT
      PDTOP=>cc%PDTOP
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PT from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='PT'                                 &  !<-- Extract PT
                            ,value=PT                                   &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PDTOP from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='PDTOP'                              &  !<-- Extract PDTOP
                            ,value=PDTOP                                &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%PSGML1(1:LM),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PSGML1 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      PSGML1=>cc%PSGML1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PSGML1 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='PSGML1'                         &  !<-- Name of Attribute to extract
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=PSGML1                           &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      LMP1=LM+1
      ALLOCATE(cc%SG1(1:LMP1),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%SG1 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      SG1=>cc%SG1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract SG1 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='SG1'                            &  !<-- Name of Attribute to extract
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=SG1                              &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%SG2(1:LMP1),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%SG2 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      SG2=>cc%SG2
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract SG2 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='SG2'                            &  !<-- Name of Attribute to extract
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=SG2                              &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%SGML2(1:LM),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%SGML2 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      SGML2=>cc%SGML2
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract SGML2 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='SGML2'                          &  !<-- Name of Attribute to extract
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=SGML2                            &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%DSG2(1:LM),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%DSG2 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      DSG2=>cc%DSG2
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DSG2 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='DSG2'                           &  !<-- Extract DSG2
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=DSG2                             &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%PDSG1(1:LM),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PDSG1 stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      PDSG1=>cc%PDSG1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PDSG1 from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='PDSG1'                          &  !<-- Extract PDSG1
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=PDSG1                            &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------
!***  DYH,DXH
!-------------
!
      DYH=>cc%DYH
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DYH from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='DYH'                                &  !<-- Extract DYH
                            ,value=DYH                                  &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ALLOCATE(CC%DXH(JDS:JDE),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%DXH stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      DXH=>cc%DXH
!
      NKOUNT=JDE-JDS+1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DXH from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state    =IMP_STATE                        &  !<-- The parent-child coupler import state
                            ,name     ='DXH'                            &  !<-- Name of Attribute to extract
                            ,itemCount=NKOUNT                           &  !<-- # of words in data list
                            ,valueList=DXH                              &  !<-- Put the extracted Attribute here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------
!***  DPHD,DLMD,JM
!------------------
!
      DLM=>cc%DLM
      DPH=>cc%DPH
      JM=>cc%JM
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~~~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DPHD,DLMD from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~~~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='DLMD'                               &  !<-- Extract grid's longitude increment (deg)
                            ,value=DLM                                  &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='DPHD'                               &  !<-- Extract grid's latitude increment (deg)
                            ,value=DPH                                  &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='JM'                                 &  !<-- Extract J extent of domain
                            ,value=JM                                   &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      D_ONE=1.
      D_180=180.
      PI=DACOS(-D_ONE)
      D2R=PI/D_180
!
      DLM=DLM*D2R                                                          !<-- Convert from degrees to radians
      DPH=DPH*D2R                                                          !<-- Convert from degrees to radians
!
!------------
!***  INDX_Q
!------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract INDX_Q from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='INDX_Q'                             &  !<-- Name of Attribute to extract
                            ,value=INDX_Q                               &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------
!***  INDX_CW
!-------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract INDX_CW from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                              &  !<-- The parent-child coupler import state
                            ,name ='INDX_CW'                              &  !<-- Name of Attribute to extract
                            ,value=INDX_CW                                &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%Q=>TRACERS(IMS:IME,JMS:JME,1:LM,INDX_Q)
      cc%CW=>TRACERS(IMS:IME,JMS:JME,1:LM,INDX_CW)
!
!-----------------------------------------------------------------------
!***  Extract the Bundles holding pointers to nest boundary variables
!***  updated by the parents (used in all nesting) and to 2-way 
!***  variables updated by the child on the parent (if indeed 2-way
!***  nesting is invoked).  Since the Fields in these Bundles will be 
!***  accessed via looping through the Bundles then we need to know
!***  how many total Fields are present as well as specifically how
!***  many are on H points and on V points. 
!-----------------------------------------------------------------------
!
      IF(I_AM_A_FCST_TASK)THEN
!
!-----------------------------------------------------------------------
!***  Begin with the Bundle of pointers to the variables specified
!***  by the user that are to be updated on the nest boundaries.
!***  In addition to the total number of such variables, we need
!***  to know how many of them are on H points and how many are
!***  on V points.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Nest BC Bundle in P-C Init"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateGet(state      =IMP_STATE                        &  !<-- The Parent-Child coupler import state
                          ,itemname   ='Bundle_nestbc'                  &  !<-- Name of Bundle of nest BC internal state arrays to use
                          ,fieldbundle=BUNDLE_NESTBC                    &  !<-- The ESMF nest BC Bundle
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="How many Fields in the Nest BC Bundle?"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_NESTBC              &  !<-- The ESMF Bundle of 2-way exchange variables
                                ,fieldcount =NVARS_NESTBC               &  !<-- # of Fields in the Bundle
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NLEV_H=>cc%NLEV_H
        NLEV_V=>cc%NLEV_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract # of Model Lyrs for all Nest BC Variables"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NLEV_H'                           &  !<-- Name of Attribute to extract
                              ,value=NLEV_H                             &  !<-- # of model lyrs for all BC H-pt variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NLEV_V'                           &  !<-- Name of Attribute to extract
                              ,value=NLEV_V                             &  !<-- # of model lyrs for all BC H-pt variables
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NVARS_BC_2D_H=>cc%NVARS_BC_2D_H
        NVARS_BC_3D_H=>cc%NVARS_BC_3D_H
        NVARS_BC_4D_H=>cc%NVARS_BC_4D_H
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract # of H-pt Nest BC Variables from P-C Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NVARS_BC_2D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_2D_H                      &  !<-- # of 2-D H-pt boundary variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NVARS_BC_3D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_3D_H                      &  !<-- # of 3-D H-pt boundary variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NVARS_BC_4D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_4D_H                      &  !<-- # of 4-D H-pt boundary variables
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NVARS_BC_2D_V=>cc%NVARS_BC_2D_V
        NVARS_BC_3D_V=>cc%NVARS_BC_3D_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract # of V-pt Nest BC Variables from P-C Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NVARS_BC_2D_V'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_2D_V                      &  !<-- # of 2-D V-pt boundary variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='NVARS_BC_3D_V'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_3D_V                      &  !<-- # of 3-D V-pt boundary variables
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NVARS_NESTBC_H=NVARS_BC_2D_H+NVARS_BC_3D_H+NVARS_BC_4D_H
        NVARS_NESTBC_V=NVARS_BC_2D_V+NVARS_BC_3D_V
!
        IF(.NOT.ALLOCATED(NBASE_VAR_H))THEN
          ALLOCATE(NBASE_VAR_H(1:NVARS_NESTBC_H-1))
        ENDIF
!
        IF(.NOT.ALLOCATED(NBASE_VAR_V))THEN
          ALLOCATE(NBASE_VAR_V(1:NVARS_NESTBC_V))
        ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Allocate the objects that hold the boundary values for arrays
!***  of various dimensions.  While it is certain there will be 2-D
!***  H-pt variables (PD) and 3-D H-pt and V-pt variables (T,Q,U,V)
!***  there may not be 4-D H-pt or 2-D V-pt variables so account for
!***  the possible lack of those.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%MY_BC_VARS_H_S%VAR_2D(1:NVARS_BC_2D_H))
        ALLOCATE(cc%MY_BC_VARS_H_N%VAR_2D(1:NVARS_BC_2D_H))
        ALLOCATE(cc%MY_BC_VARS_H_W%VAR_2D(1:NVARS_BC_2D_H))
        ALLOCATE(cc%MY_BC_VARS_H_E%VAR_2D(1:NVARS_BC_2D_H))
!
        ALLOCATE(cc%MY_BC_VARS_H_S%VAR_3D(1:NVARS_BC_3D_H))
        ALLOCATE(cc%MY_BC_VARS_H_N%VAR_3D(1:NVARS_BC_3D_H))
        ALLOCATE(cc%MY_BC_VARS_H_W%VAR_3D(1:NVARS_BC_3D_H))
        ALLOCATE(cc%MY_BC_VARS_H_E%VAR_3D(1:NVARS_BC_3D_H))
!
        IF(NVARS_BC_4D_H==0)THEN
          ALLOCATE(cc%MY_BC_VARS_H_S%VAR_4D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_H_N%VAR_4D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_H_W%VAR_4D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_H_E%VAR_4D(-1:-1))
        ELSEIF(NVARS_BC_4D_H>0)THEN
          ALLOCATE(cc%MY_BC_VARS_H_S%VAR_4D(1:NVARS_BC_4D_H))
          ALLOCATE(cc%MY_BC_VARS_H_N%VAR_4D(1:NVARS_BC_4D_H))
          ALLOCATE(cc%MY_BC_VARS_H_W%VAR_4D(1:NVARS_BC_4D_H))
          ALLOCATE(cc%MY_BC_VARS_H_E%VAR_4D(1:NVARS_BC_4D_H))
        ENDIF
!
        IF(NVARS_BC_2D_V==0)THEN
          ALLOCATE(cc%MY_BC_VARS_V_S%VAR_2D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_V_N%VAR_2D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_V_W%VAR_2D(-1:-1))
          ALLOCATE(cc%MY_BC_VARS_V_E%VAR_2D(-1:-1))
        ELSEIF(NVARS_BC_2D_V>0)THEN
          ALLOCATE(cc%MY_BC_VARS_V_S%VAR_2D(1:NVARS_BC_2D_V))
          ALLOCATE(cc%MY_BC_VARS_V_N%VAR_2D(1:NVARS_BC_2D_V))
          ALLOCATE(cc%MY_BC_VARS_V_W%VAR_2D(1:NVARS_BC_2D_V))
          ALLOCATE(cc%MY_BC_VARS_V_E%VAR_2D(1:NVARS_BC_2D_V))
        ENDIF
!
        ALLOCATE(cc%MY_BC_VARS_V_S%VAR_3D(1:NVARS_BC_3D_V))
        ALLOCATE(cc%MY_BC_VARS_V_N%VAR_3D(1:NVARS_BC_3D_V))
        ALLOCATE(cc%MY_BC_VARS_V_W%VAR_3D(1:NVARS_BC_3D_V))
        ALLOCATE(cc%MY_BC_VARS_V_E%VAR_3D(1:NVARS_BC_3D_V))
!
!-----------------------------------------------------------------------
!***  Extract the lower and upper bounds of each of the 4-D H-pt
!***  boundary variables.
!-----------------------------------------------------------------------
!
        IF(NVARS_BC_4D_H==0)THEN
!
          ALLOCATE(cc%LBND_4D(1:1))
          ALLOCATE(cc%UBND_4D(1:1))
!
          cc%LBND_4D(1)=-1
          cc%UBND_4D(1)=-1
!
        ELSEIF(NVARS_BC_4D_H>0)THEN
!
          ALLOCATE(cc%LBND_4D(1:NVARS_BC_4D_H))
          ALLOCATE(cc%UBND_4D(1:NVARS_BC_4D_H))
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Lower Bounds of 4-D Bndry Vbls"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state    =IMP_STATE                    &  !<-- The parent-child coupler import state
                                ,name     ='LBND_4D'                    &  !<-- Extract Attribute with this name
                                ,itemCount=NVARS_BC_4D_H                &  !<-- How many items?
                                ,valueList=cc%LBND_4D                   &  !<-- Lower bounds of 4-D H-pt bndry vbls
                                ,rc       =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Upper Bounds of 4-D Bndry Vbls"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state    =IMP_STATE                    &  !<-- The parent-child coupler import state
                                ,name     ='UBND_4D'                    &  !<-- Extract Attribute with this name
                                ,itemCount=NVARS_BC_4D_H                &  !<-- How many items?
                                ,valueList=cc%UBND_4D                   &  !<-- Upper bounds of 4-D H-pt bndry vbls
                                ,rc       =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~


!! TODO: Bouds hardcoded - to be modified!
!          cc%LBND_4D(1)=8
!          cc%UBND_4D(1)=16
!
        ENDIF

!
!-----------------------------------------------------------------------
!
        IF(NVARS_NESTBC/=NVARS_BC_2D_H+NVARS_BC_3D_H+NVARS_BC_4D_H      &
                        +NVARS_BC_2D_V+NVARS_BC_3D_V)THEN
          WRITE(0,22001)NVARS_NESTBC
22001     FORMAT(' Total # of variables in nest BC Bundle is ',I4)
          WRITE(0,22002)NVARS_BC_2D_H+NVARS_BC_3D_H+NVARS_BC_4D_H
22002     FORMAT(' # of H-pt nest BC variables is ',I4)
          WRITE(0,22002)NVARS_BC_2D_V+NVARS_BC_3D_V
22003     FORMAT(' # of V-pt nest BC variables is ',I4)
          WRITE(0,22004)
22004     FORMAT(' They do not add up so ABORT!!')
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT                 &
                            ,rc             =RC)
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Extract the mode of nesting, i.e., 1-way or 2-way.  Use the
!***  configure file of domain #1 where the variable is required.
!-----------------------------------------------------------------------
!
      CF_1=ESMF_ConfigCreate(rc=RC)
!
      CONFIG_FILE_NAME='configure_file_01'                                 !<-- Config file name of uppermost parent
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Load Configure Object of Upper Domain in P-C Cpl Init1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigLoadFile(config  =CF_1                            &
                              ,filename=CONFIG_FILE_NAME                &
                              ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init1: Extract Nesting Mode from Config File 1"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF_1                          &  !<-- The config object for the uppermost domain
                                  ,value =NEST_MODE                     &  !<-- The mode of nesting ('1-way' or '2-way')
                                  ,label ='nest_mode:'                  &  !<-- Give this label's value to the previous variable
                                  ,rc    =RC)
!
!-----------------------------------------------------------------------
!***  Tasks load their domain's configure file.
!-----------------------------------------------------------------------
!
      CONFIG_ID=DOMAIN_ID_TO_RANK(MY_DOMAIN_ID)
      WRITE(INT_TO_CHAR,FMT)CONFIG_ID
      CONFIG_FILE_NAME='configure_file_'//INT_TO_CHAR                      !<-- Prepare the config file name
!
      CF_MINE=>cc%CF_MINE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Parent-Child Init: Domain Loads Its Configure File"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigLoadFile(config  =CF_MINE                         &
                              ,filename=CONFIG_FILE_NAME                &
                              ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Children need to save the ratio of their parent's timestep and
!***  grid increment to their own.  The timestep ratio MUST be an
!***  integer and for now so must the space ratio.
!***  Then obtain the parent I,J of the nest's SW corner.
!-----------------------------------------------------------------------
!
      child_block: IF(MY_DOMAIN_ID>1)THEN                                  !<-- Select the children
!
!-----------------------------------------------------------------------
!
        DT_PARENT=DT_DOMAIN(ID_PARENTS(MY_DOMAIN_ID))
!
        TIME_RATIO_MY_PARENT=>cc%TIME_RATIO_MY_PARENT
        TIME_RATIO_MY_PARENT=NINT(DT_PARENT/DT_DOMAIN(MY_DOMAIN_ID))       !<-- Ratio of my parent's timestep to mine
!
!-----------------------------------------------------------------------
!***  In order to allow moving nests to be updated their tasks need
!***  to know their domain's forecast task layout as well as that of
!***  their parents.  Likewise the parents of moving nests need to
!***  know the forecast task layout of their moving children.  For
!***  simplicity we will provide that information to all domain tasks
!***  now.
!***  The SW corner location of the nests is read from the configure
!***  files for regular forecasts but must come from the restart
!***  file data for restarted runs.
!-----------------------------------------------------------------------
!
        SPACE_RATIO_MY_PARENT=>cc%SPACE_RATIO_MY_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Parent-Child Init: Child Gets Space Ratio"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_ConfigGetAttribute(config=CF_MINE                     &  !<-- The child's config object
                                    ,value =SPACE_RATIO_MY_PARENT       &  !<-- The variable filled (Parent-to-child space ratio)
                                    ,label ='parent_child_space_ratio:' &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        cc%RECIP_PARENT_SPACE_RATIO=1./REAL(SPACE_RATIO_MY_PARENT)
!
!-----------------------------------------------------------------------
!
        INPES=>cc%INPES
        JNPES=>cc%JNPES
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Parent-Child Init: Child Gets INPES,JNPES"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_ConfigGetAttribute(config=CF_MINE                     &  !<-- The child's config object
                                    ,value =INPES                       &  !<-- The variable filled (fcst tasks in I direction)
                                    ,label ='inpes:'                    &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
        CALL ESMF_ConfigGetAttribute(config=CF_MINE                     &  !<-- The child's config object
                                    ,value =JNPES                       &  !<-- The variable filled (fcst tasks in J direction)
                                    ,label ='jnpes:'                    &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Task 0 on each child receives the domain index limits of their
!***  parents then braodcasts them to the other child tasks.
!***  Task 0 on each child then receives the integration limits of
!***  their parents' forecast tasks and broadcasts that information to
!***  the remaining child tasks.
!***  Also each child task needs to allocate the derived type that will
!***  hold: (i) Which parent task(s) will send boundary data to it;
!***  (ii) The grid index limits on the child boundary covered by
!***  the parent task's data the child will receive.  Then it receives
!***  those pieces of information from the parent.
!-----------------------------------------------------------------------
!
        MY_PARENT_ID=ID_PARENTS(MY_DOMAIN_ID)                              !<-- Domain ID of the current domain's parent
!
!-----------------------------------------------------------------------
!
        NUM_FCST_TASKS_PARENT=FTASKS_DOMAIN(MY_PARENT_ID)                  !<-- # of forecast tasks on the parent's domain
!
        ALLOCATE(PTASK_LIMITS(MY_DOMAIN_ID)%ITS(0:NUM_FCST_TASKS_PARENT-1)) !<-- Task subdomain limits for current domain's parent
        ALLOCATE(PTASK_LIMITS(MY_DOMAIN_ID)%ITE(0:NUM_FCST_TASKS_PARENT-1)) !
        ALLOCATE(PTASK_LIMITS(MY_DOMAIN_ID)%JTS(0:NUM_FCST_TASKS_PARENT-1)) !
        ALLOCATE(PTASK_LIMITS(MY_DOMAIN_ID)%JTE(0:NUM_FCST_TASKS_PARENT-1)) !<--
!
        DO N=0,NUM_FCST_TASKS_PARENT-1
          PTASK_LIMITS(MY_DOMAIN_ID)%ITS(N)=-9999
          PTASK_LIMITS(MY_DOMAIN_ID)%ITE(N)=-9999
          PTASK_LIMITS(MY_DOMAIN_ID)%JTS(N)=-9999
          PTASK_LIMITS(MY_DOMAIN_ID)%JTE(N)=-9999
        ENDDO
!
        CALL MPI_BARRIER(COMM_FCST_TASKS,IERR)                             !<-- Syncs all child fcst tasks on this domain
!
!-----------------------------------------------------------------------
!***  Child task 0 recvs its parent's domain limits and task subdomain
!***  limits from parent task 0.
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
!
          NTAG=MY_DOMAIN_ID*111+1
          CALL MPI_RECV(cc%PARENT_DOMAIN_LIMITS                         &  !<-- This domain's parent's domain index limits
                       ,4                                               &  !<-- Total words received
                       ,MPI_INTEGER                                     &  !<-- Indices are integers
                       ,0                                               &  !<-- Receive from this parent task
                       ,NTAG                                            &  !<-- Unique MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- The MPI communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(PTASK_LIMITS(MY_DOMAIN_ID)%ITS                  &  !<-- Starting I on each parent forecast task's subdomain
                       ,NUM_FCST_TASKS_PARENT                           &  !<-- Total words received
                       ,MPI_INTEGER                                     &  !<-- Indices are integers
                       ,0                                               &  !<-- Receive from this parent task
                       ,NTAG                                            &  !<-- Unique MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- The MPI communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NTAG=NTAG+1
          CALL MPI_RECV(PTASK_LIMITS(MY_DOMAIN_ID)%JTS                  &  !<-- Starting J on each parent forecast task's subdomain
                       ,NUM_FCST_TASKS_PARENT                           &  !<-- Total words received
                       ,MPI_INTEGER                                     &  !<-- Indices are integers
                       ,0                                               &  !<-- Receive from this parent task
                       ,NTAG                                            &  !<-- Unique MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- The MPI communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NTAG=NTAG+1
          CALL MPI_RECV(PTASK_LIMITS(MY_DOMAIN_ID)%ITE                  &  !<-- Ending I on each parent forecast task's subdomain
                       ,NUM_FCST_TASKS_PARENT                           &  !<-- Total words received
                       ,MPI_INTEGER                                     &  !<-- Indices are integers
                       ,0                                               &  !<-- Receive from this parent task
                       ,NTAG                                            &  !<-- Unique MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- The MPI communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NTAG=NTAG+1
          CALL MPI_RECV(PTASK_LIMITS(MY_DOMAIN_ID)%JTE                  &  !<-- Ending J on each parent forecast task's subdomain
                       ,NUM_FCST_TASKS_PARENT                           &  !<-- Total words received
                       ,MPI_INTEGER                                     &  !<-- Indices are integers
                       ,0                                               &  !<-- Receive from this parent task
                       ,NTAG                                            &  !<-- Unique MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- The MPI communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  The lead child task sends the parent's domain limits and 
!***  task subdomain limits to all the other child forecast tasks.
!-----------------------------------------------------------------------
!
        CALL MPI_BCAST(cc%PARENT_DOMAIN_LIMITS                          &  !<-- This domain's parent's domain index limits
                      ,4                                                &  !<-- There are 4 index limits
                      ,MPI_INTEGER                                      &  !<-- Data are integers
                      ,0                                                &  !<-- Data sent from child task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
!
        CALL MPI_BCAST(PTASK_LIMITS(MY_DOMAIN_ID)%ITS                   &  !<-- Starting I indices for parent subdomains
                      ,NUM_FCST_TASKS_PARENT                            &  !<-- # of words in the data
                      ,MPI_INTEGER                                      &  !<-- Data are integers
                      ,0                                                &  !<-- Data sent from child task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
!
        CALL MPI_BCAST(PTASK_LIMITS(MY_DOMAIN_ID)%ITE                   &  !<-- Ending I indices for parent subdomains
                      ,NUM_FCST_TASKS_PARENT                            &  !<-- # of words in the data
                      ,MPI_INTEGER                                      &  !<-- Data are integers
                      ,0                                                &  !<-- Data sent from child task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
!
        CALL MPI_BCAST(PTASK_LIMITS(MY_DOMAIN_ID)%JTS                   &  !<-- Starting J indices for parent subdomains
                      ,NUM_FCST_TASKS_PARENT                            &  !<-- # of words in the data
                      ,MPI_INTEGER                                      &  !<-- Data are integers
                      ,0                                                &  !<-- Data sent from child task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
!
        CALL MPI_BCAST(PTASK_LIMITS(MY_DOMAIN_ID)%JTE                   &  !<-- Ending J indices for parent subdomains
                      ,NUM_FCST_TASKS_PARENT                            &  !<-- # of words in the data
                      ,MPI_INTEGER                                      &  !<-- Data are integers
                      ,0                                                &  !<-- Data sent from child task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
!
!-----------------------------------------------------------------------
!***  Children receive from their parents basic bookkeeping information
!***  needed for the exchange of boundary data during the integration.
!-----------------------------------------------------------------------
!
        MY_PARENT_ID=ID_PARENTS(MY_DOMAIN_ID)                              !<-- Domain ID of the current domain's parent
        ALLOCATE(CC%PARENT_TASK(1:FTASKS_DOMAIN(MY_PARENT_ID)))            !<-- Dimensioned as # of fcst tasks on domain of parent.
!
        CALL CHILD_RECVS_CHILD_DATA_LIMITS(EXP_STATE,MY_DOMAIN_ID)         !<-- Recv specs of new parent/child task associations
!
!-----------------------------------------------------------------------
!***  All the children send to their parents their boundary
!***  topography so that the parents can properly balance the data
!***  generated for the children's boundaries.  For moving nests
!***  these are only initial values that will change when the nests
!***  move.
!-----------------------------------------------------------------------
!
        CALL CHILD_SENDS_TOPO_TO_PARENT(MY_DOMAIN_ID,IMP_STATE)
!
!-----------------------------------------------------------------------
!***  Children are going to need some information from their
!***  parents' configure files so load those objects into memory.
!-----------------------------------------------------------------------
!
        MY_PARENT_ID=ID_PARENTS(MY_DOMAIN_ID)
        CONFIG_ID=DOMAIN_ID_TO_RANK(MY_PARENT_ID)
        WRITE(INT_TO_CHAR,FMT)CONFIG_ID
        CONFIG_FILE_NAME='configure_file_'//INT_TO_CHAR                    !<-- Prepare the parent's config file name
!
        cc%CF_PARENT=ESMF_ConfigCreate(rc=RC)
        CF_PARENT=>cc%CF_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Parent-Child Init1: Nest Loads Parent Config File"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_ConfigLoadFile(config  =CF_PARENT                     &
                                ,filename=CONFIG_FILE_NAME              &
                                ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  What is the parent's layout of forecast tasks?
!-----------------------------------------------------------------------
!
        INPES_PARENT=>cc%INPES_PARENT
        JNPES_PARENT=>cc%JNPES_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Parent-Child Init1: Child Gets Parent INPES,JNPES"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_ConfigGetAttribute(config=CF_PARENT                   &  !<-- The parent's config object
                                    ,value =INPES_PARENT                &  !<-- The variable filled (fcst tasks in I direction)
                                    ,label ='inpes:'                    &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
        CALL ESMF_ConfigGetAttribute(config=CF_PARENT                   &  !<-- The parent's config object
                                    ,value =JNPES_PARENT                &  !<-- The variable filled (fcst tasks in J direction)
                                    ,label ='jnpes:'                    &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  If this child moves then some additional information is gathered.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Move Flag from Nest's Configure File"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_ConfigGetAttribute(config=CF_MINE                     &  !<-- The child's config object
                                    ,value =MY_DOMAIN_MOVES             &  !<-- The variable filled (Move flag)
                                    ,label ='my_domain_moves:'          &  !<-- Give this label's value to the previous variable
                                    ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Moving nests must know if their parents move.
!-----------------------------------------------------------------------
!
        MY_PARENT_MOVES=>cc%MY_PARENT_MOVES
        MY_PARENT_MOVES=.FALSE.
!
        IF(MY_DOMAIN_MOVES)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Nest Checks If Parent Moves"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_PARENT                 &  !<-- The parent's config object
                                      ,value =MY_PARENT_MOVES           &  !<-- The variable filled (does the parent move?)
                                      ,label ='my_domain_moves:'        &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(MY_PARENT_MOVES)THEN
            cc%FORCED_PARENT_SHIFT=.FALSE.
          ENDIF
!
          DO N=1,3
            cc%PARENT_SHIFT(N)=-999
          ENDDO
!
!-----------------------------------------------------------------------
!***  Since the nests can only move on parent timesteps and
!***  are allowed to move only on physics timesteps then 
!***  warn the user if the Parent timestep ratio does not
!***  divide evenly into the nest's physics frequency.
!-----------------------------------------------------------------------
!
          NPHS=>cc%NPHS
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Child Gets NPHS"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =NPHS                      &  !<-- The variable filled (frequency of physics calls)
                                      ,label ='nphs:'                   &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(MOD(NPHS,TIME_RATIO_MY_PARENT)/=0)THEN
            WRITE(0,*)' WARNING: Moving nest parent time ratio does'    &
                     ,' not divide into its NPHS!!!'
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Moving nests must know the move type
!-----------------------------------------------------------------------
!
        IF(MY_DOMAIN_MOVES)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Move Type Flag from Nest's Configure File"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The child's config object
                                      ,value =MOVE_TYPE                 &  !<-- The variable filled (type of this child's move)
                                      ,label ='move_type:'              &  !<-- Give this label's value to the previous variabl
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF (TRIM(MOVE_TYPE) == 'prescribed') THEN

            WRITE(PRESCRIBED_FILENAME,"(A,I2.2)") 'prescribed_moves_',MY_DOMAIN_ID

            OPEN(99,FILE=PRESCRIBED_FILENAME,STATUS='OLD',ACTION='READ',IOSTAT=ISTAT)

            IF(ISTAT/=0)THEN
              WRITE(0,*)' Failed to open ',PRESCRIBED_FILENAME,' stat=',ISTAT
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF

            READ(99,*)MOVE_INTERVAL_MINUTES

            N_MOVES=0
            DO WHILE(.TRUE.)
              N_MOVES=N_MOVES+1
              READ(99,*,END=101)
            ENDDO
       101  CONTINUE
            N_MOVES=N_MOVES-1

            REWIND(99)

            ALLOCATE(MOVE_MINUTE(N_MOVES))
            ALLOCATE(MOVE_I_SW(N_MOVES))
            ALLOCATE(MOVE_J_SW(N_MOVES))
      
            READ(99,*)
            DO N=1,N_MOVES
              READ(99,*)MOVE_MINUTE(N),MOVE_I_SW(N),MOVE_J_SW(N)
            END DO

            CLOSE(99)

!            write(0,*)'MOVE_INTERVAL_MINUTES=',MOVE_INTERVAL_MINUTES
!            write(0,*)'N_MOVES=',N_MOVES
!            DO N=1,N_MOVES
!              write(0,*)'MOVE_MINUTE(N),MOVE_I_SW(N),MOVE_J_SW(N)',N,MOVE_MINUTE(N),MOVE_I_SW(N),MOVE_J_SW(N)
!            END DO
!
          END IF
!
!-----------------------------------------------------------------------
!***  The user can specify if a nest's motion must be limited to
!***  only a certain number of its parent's grid increments per
!***  shift.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Shift Limit from Nest's Configure File"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          MAX_SHIFT=>cc%MAX_SHIFT
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The child's config object
                                      ,value =MAX_SHIFT                 &  !<-- Max shift in parent I,J this nest can execute
                                      ,label ='max_shift:'              &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Collisions must be avoided between a moving nest and its 
!***  independently moving child.  When the inner nest gets too
!***  close to the outer nest's boundary then the inner nest will
!***  inform the outer nest that it (outer) must move away.  
!***  Use a totally empirical relation to determine the distance
!***  measured in parent gridpoints that the parent is pushed
!***  by the child.  Likewise compute the minimum distance in parent 
!***  grid increments that the child can be to its parent's
!***  boundary.  These values are used by moving children and are
!***  are only relevant if the parent also moves.
!-----------------------------------------------------------------------
!
          MAX_FORCED_SHIFT=-999
          MIN_DIST_PARENT=-999.
!
          IF(MY_PARENT_ID>1)THEN
            GRID_DIST_KM=DPH*A*1.E-3                                         !<-- Approximate grid increment in km
            CONST1=-8./15.
            CONST2=15.33333
            MAX_FORCED_SHIFT=NINT(GRID_DIST_KM*SPACE_RATIO_MY_PARENT*CONST1+CONST2)
            MAX_FORCED_SHIFT=MIN(MAX_FORCED_SHIFT,10)
            MAX_FORCED_SHIFT=MAX(MAX_FORCED_SHIFT, 2)
!
            CONST3=-1./3.
            CONST4=11.33333
            MIN_DIST_PARENT=GRID_DIST_KM*SPACE_RATIO_MY_PARENT*CONST3+CONST4
            MIN_DIST_PARENT=MIN(MIN_DIST_PARENT,8.)
            MIN_DIST_PARENT=MAX(MIN_DIST_PARENT,3.)
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  If the run will use 2-way nesting then allocate the objects
!***  the children will use to hold the indices of the points to
!***  be updated on each parent task.  The use of the upper dimension
!***  of 4 in the following allocations is a reflection of the fact
!***  that a nest task can update no more than 4 parent task subdomains
!***  under the assumption that parent task subdomains must always 
!***  cover a larger physical area than child task subdomains.
!-----------------------------------------------------------------------
!
        IF(NEST_MODE=='2-way')THEN
!
!-----------------------------------------------------------------------
!
          CALLED_CHILD_2WAY_BOOKKEEPING=>cc%CALLED_CHILD_2WAY_BOOKKEEPING
          CALLED_CHILD_2WAY_BOOKKEEPING=.FALSE.
!
          ALLOCATE(cc%UPDATE_PARENT_2WAY(1:4))
!
          ALLOCATE(cc%ID_PARENT_UPDATE_TASKS(1:4))
          ALLOCATE(cc%NPTS_UPDATE_ON_PARENT_TASKS(1:4))
!
          ALLOCATE(cc%I_2WAY_UPDATE(1:4))
          ALLOCATE(cc%J_2WAY_UPDATE(1:4))
!
          ALLOCATE(cc%I_2WAY_H(1:4))
          ALLOCATE(cc%J_2WAY_H(1:4))
          ALLOCATE(cc%I_2WAY_V(1:4))
          ALLOCATE(cc%J_2WAY_V(1:4))
!
          ALLOCATE(cc%CHILD_SFC_ON_PARENT(1:4))
!
          ALLOCATE(cc%HANDLE_SEND_2WAY_DATA(1:4))
          ALLOCATE(cc%HANDLE_SEND_2WAY_SFC(1:4))
!
          DO N=1,4
!
            cc%UPDATE_PARENT_2WAY(N)%DATA=>NULL()
!
            cc%ID_PARENT_UPDATE_TASKS(N)=0
            cc%NPTS_UPDATE_ON_PARENT_TASKS(N)=0
!
            cc%I_2WAY_UPDATE(N)%DATA=>NULL()
            cc%J_2WAY_UPDATE(N)%DATA=>NULL()
!
            cc%I_2WAY_H(N)%DATA=>NULL()
            cc%J_2WAY_H(N)%DATA=>NULL()
            cc%I_2WAY_V(N)%DATA=>NULL()
            cc%J_2WAY_V(N)%DATA=>NULL()
!
            cc%CHILD_SFC_ON_PARENT(N)%DATA=>NULL()
!
            cc%HANDLE_SEND_2WAY_DATA(N)=MPI_REQUEST_NULL
            cc%HANDLE_SEND_2WAY_SFC(N) =MPI_REQUEST_NULL
!
          ENDDO
!
          cc%NTASKS_UPDATE_PARENT=0
!
          cc%NTIMESTEP_WAIT_PARENT=0
          cc%NTIMESTEP_WAIT_FORCED_PARENT=0
!
          cc%PARENT_WANTS_TO_MOVE=.FALSE.
!
!-----------------------------------------------------------------------
!***  The averaging stencil used by the child to interpolate its
!***  gridpoint values to the parent's points must have permissible
!***  values.  The range of theoretical values are:

!                          Parent-Child Space Ratio
!              Odd                                       Even
!
!  N_STENCIL_H (h-->H): 1,3,5,..              N_STENCIL_H (h-->H): 1,3,5,..
!  N_STENCIL_V (v-->V): 1,3,5,..              N_STENCIL_V (v-->V): 2,4,6,..
!  N_STENCIL_SFC_H (fis,pd-->H): 1,3,5,..     N_STENCIL_SFC_H (fis,pd-->H): 1,3,5,..
!  N_STENCIL_SFC_V (fis,pd-->V): 2,4,6,..     N_STENCIL_SFC_V (fis,pd-->V): 1,3,5,..
!
!***  where small letters refer to the child and capitals to the parent.
!***  The stencils are oriented along I and J (they are not rotated
!***  diamonds).  A stencil of 1 means the child point lies on top
!***  of a parent point and can thus be lifted directly to the parent
!***  point with no interpolation.  A stencil of 2 means a 2x2 square
!***  of child points surrounding the parent point are used to average
!***  onto the parent point.  Likewise for 3x3, etc.  Note that for
!***  odd parent-to-child space ratios with odd stencil values the
!***  type of child point (h or v) lying on the the target parent
!***  point is the same as that target point whereas if the stencil
!***  value is even then the child and parent point types are
!***  different.  That is not the case with an even parent-to-child
!***  space ratio as seen in the above table.
!
!***  HOWEVER, due to the MPI subdomain haloes we must select values
!***  that are less than or equal to 3 (halo width is set in module
!***  VARS_STATE with IHALO,JHALO).  If the halo width increases then
!***  so can the stencil values.
!-----------------------------------------------------------------------
!
          N_STENCIL_H    =>cc%N_STENCIL_H
          N_STENCIL_V    =>cc%N_STENCIL_V
          N_STENCIL_SFC_H=>cc%N_STENCIL_SFC_H
          N_STENCIL_SFC_V=>cc%N_STENCIL_SFC_V
!
          IF(MOD(SPACE_RATIO_MY_PARENT,2)==1)THEN 
            N_STENCIL_H=STENCIL_H_ODD                                      !<-- 
            N_STENCIL_V=STENCIL_V_ODD                                      !  Parent-Child space ratio
            N_STENCIL_SFC_H=STENCIL_SFC_H_ODD                              !  is odd
            N_STENCIL_SFC_V=STENCIL_SFC_V_ODD                              !<--
          ELSE
            N_STENCIL_H=STENCIL_H_EVEN                                     !<--
            N_STENCIL_V=STENCIL_V_EVEN                                     !  Parent-Child space ratio
            N_STENCIL_SFC_H=STENCIL_SFC_H_EVEN                             !  is even
            N_STENCIL_SFC_V=STENCIL_SFC_V_EVEN                             !<--
          ENDIF
!
          IF(MOD(N_STENCIL_H,2)/=1)THEN
            WRITE(0,*)' N_STENCIL_H must be odd for any Parent-Child space ratio!!!'
            WRITE(0,15551)SPACE_RATIO_MY_PARENT,N_STENCIL_H
15551       FORMAT(' Parent-Child space ratio=',I2 &
                     ,' but N_STENCIL_H=',I2)
            WRITE(0,*)' Aborting!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
!
          IF(MOD(N_STENCIL_SFC_H,2)/=1)THEN
            WRITE(0,*)' N_STENCIL_SFC_H must be odd for any Parent-Child space ratio!!!'
            WRITE(0,15552)SPACE_RATIO_MY_PARENT,N_STENCIL_SFC_H
15552       FORMAT(' Parent-Child space ratio=',I2 &
                     ,' but N_STENCIL_SFC_H=',I2)
            WRITE(0,*)' Aborting!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
!
          IF(MOD(SPACE_RATIO_MY_PARENT,2)==1)THEN                          !<-- For odd parent-child space ratios
!
            IF(MOD(N_STENCIL_V,2)/=1)THEN
              WRITE(0,*)' N_STENCIL_V must be odd for odd Parent-Child space ratios!!!'
              WRITE(0,15553)SPACE_RATIO_MY_PARENT,N_STENCIL_V
15553         FORMAT(' Parent-Child space ratio=',I2 &
                       ,' but N_STENCIL_V=',I2)
              WRITE(0,*)' Aborting!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF
!
            IF(MOD(N_STENCIL_SFC_V,2)/=0)THEN
              WRITE(0,*)' N_STENCIL_SFC_V must be even for odd Parent-Child space ratios!!!'
              WRITE(0,15554)SPACE_RATIO_MY_PARENT,N_STENCIL_SFC_V
15554         FORMAT(' Parent-Child space ratio=',I2 &
                       ,' but N_STENCIL_SFC_V=',I2)
              WRITE(0,*)' Aborting!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF
!
          ENDIF
!
          IF(MOD(SPACE_RATIO_MY_PARENT,2)==0)THEN                          !<-- For even parent-child space ratios
!
            IF(MOD(N_STENCIL_V,2)/=0)THEN
              WRITE(0,*)' N_STENCIL_V must be even for even Parent-Child space ratios!!!'
              WRITE(0,15555)SPACE_RATIO_MY_PARENT,N_STENCIL_V
15555         FORMAT(' Parent-Child space ratio=',I2 &
                       ,' but N_STENCIL_V=',I2)
              WRITE(0,*)' Aborting!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF
!
            IF(MOD(N_STENCIL_SFC_V,2)/=1)THEN
              WRITE(0,*)' N_STENCIL_SFC_V must be odd for even Parent-Child space ratios!!!'
              WRITE(0,15556)SPACE_RATIO_MY_PARENT,N_STENCIL_SFC_V
15556         FORMAT(' Parent-Child space ratio=',I2 &
                       ,' but N_STENCIL_SFC_V=',I2)
              WRITE(0,*)' Aborting!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  Initialize the flag that indicates whether or not the 2-way
!***  forecast is in its first step.
!-----------------------------------------------------------------------
!
          cc%FIRST_STEP_2WAY=.TRUE.
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF child_block
!
!-----------------------------------------------------------------------
!***  Parent tasks prepare various quantities for the integration.
!-----------------------------------------------------------------------
!
      parent_block_1: IF(NUM_CHILDREN>0)THEN                               !<-- Select parents for additional setup 
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Extract integer ratios of parent-to-child timesteps.
!-----------------------------------------------------------------------
!
        ALLOCATE(CC%TIME_RATIO_MY_CHILDREN(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%TIME_RATIO_MY_CHILDREN stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
!
        TIME_RATIO_MY_CHILDREN=>cc%TIME_RATIO_MY_CHILDREN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Parent-to-Child DT Ratio from Imp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =IMP_STATE                      &  !<-- The parent-child coupler import state
                              ,name     ='Parent-Child Time Ratio'      &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of items in the Attribute
                              ,valueList=TIME_RATIO_MY_CHILDREN         &  !<-- Ratio of parent to child DTs 
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Extract the timestep from the Clock to set the initial value for
!***  the child's timestep at which it will next receive parent data.
!-----------------------------------------------------------------------
!
        CALL ESMF_ClockGet(clock       =CLOCK                           &
                          ,advanceCount=NTIMESTEP_ESMF                  &
                          ,rc          =RC)
!
        NTIMESTEP=NTIMESTEP_ESMF
!
        ALLOCATE(cc%NSTEP_CHILD_RECV(1:NUM_CHILDREN),stat=ISTAT)           !<-- Children's timesteps at which they recv data
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%NSTEP_CHILD_RECV stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
!
        NSTEP_CHILD_RECV=>cc%NSTEP_CHILD_RECV
!
        DO N=1,NUM_CHILDREN
          NSTEP_CHILD_RECV(N)=(NTIMESTEP-1)*TIME_RATIO_MY_CHILDREN(N)
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate more arrays needed by the parent to hold child
!***  information derived from the children's configure files.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%IM_CHILD(1:NUM_CHILDREN),stat=ISTAT)                   !<-- I extent of children's domains
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%IM_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        IM_CHILD=>cc%IM_CHILD
!
        ALLOCATE(cc%JM_CHILD(1:NUM_CHILDREN),stat=ISTAT)                   !<-- J extent of children's domains
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%JM_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        JM_CHILD=>cc%JM_CHILD
!
        ALLOCATE(cc%PARENT_CHILD_SPACE_RATIO(1:NUM_CHILDREN),stat=ISTAT)   !<-- Integer ratio of parent grid increment to children's
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%PARENT_CHILD_SPACE_RATIO stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        PARENT_CHILD_SPACE_RATIO=>cc%PARENT_CHILD_SPACE_RATIO
!
        ALLOCATE(cc%CHILD_PARENT_SPACE_RATIO(1:NUM_CHILDREN),stat=ISTAT)   !<-- Inverse of PARENT_CHILD_SPACE_RATIO
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_PARENT_SPACE_RATIO stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_PARENT_SPACE_RATIO=>cc%CHILD_PARENT_SPACE_RATIO
!
        ALLOCATE(cc%N_BLEND_H_CHILD(1:NUM_CHILDREN),stat=ISTAT)            !<-- Boundary blending width for child H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%N_BLEND_H_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        N_BLEND_H_CHILD=>cc%N_BLEND_H_CHILD
!
        ALLOCATE(cc%N_BLEND_V_CHILD(1:NUM_CHILDREN),stat=ISTAT)            !<-- Boundary blending width for child V points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%N_BLEND_V_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        N_BLEND_V_CHILD=>cc%N_BLEND_V_CHILD
!
        ALLOCATE(cc%CHILD_ACTIVE(1:NUM_CHILDREN),stat=ISTAT)               !<-- Will child participate in the digital filtering?
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_ACTIVE stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_ACTIVE=>cc%CHILD_ACTIVE
!
        ALLOCATE(cc%INC_FIX(1:NUM_CHILDREN),stat=ISTAT)                    !<-- See below where INC_FIX is filled
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%INC_FIX stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        INC_FIX=>cc%INC_FIX
!
        ALLOCATE(cc%RANK_2WAY_CHILD(1:NUM_CHILDREN),stat=ISTAT)            !<-- Location of moving nests in list of all children
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%RANK_2WAY_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        RANK_2WAY_CHILD=>cc%RANK_2WAY_CHILD
!
        ALLOCATE(cc%RANK_MOVING_CHILD(1:NUM_CHILDREN),stat=ISTAT)          !<-- Location of moving nests in list of all children
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%RANK_MOVING_CHILD stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        RANK_MOVING_CHILD=>cc%RANK_MOVING_CHILD
!
        ALLOCATE(cc%STATIC_OR_MOVING(1:NUM_CHILDREN),stat=ISTAT)           !<-- Are the individual children static or moving?
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%STATIC_OR_MOVING stat=',ISTAT
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        STATIC_OR_MOVING=>cc%STATIC_OR_MOVING
!
        ALLOCATE(NEST_MODE_CHILD(1:NUM_CHILDREN))
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%CF(1:NUM_CHILDREN))                                    !<-- Configure objects of this parent's children
        CF=>cc%CF
!
!-----------------------------------------------------------------------
!
        child_info_loop: DO N=1,NUM_CHILDREN
!
!-----------------------------------------------------------------------
!***  Initialize to nonsense the newly allocated arrays.
!-----------------------------------------------------------------------
!
          IM_CHILD(N)                =-999
          JM_CHILD(N)                =-999
          PARENT_CHILD_SPACE_RATIO(N)=-999
          CHILD_PARENT_SPACE_RATIO(N)=-999.
          INC_FIX(N)                 =-999
          RANK_2WAY_CHILD(N)         =-999
          RANK_MOVING_CHILD(N)       =-999
!
          STATIC_OR_MOVING(N)        ='Static'
!
!-----------------------------------------------------------------------
!***  The parent loads each of its children's configure files.
!-----------------------------------------------------------------------
!
          CF(N)=ESMF_ConfigCreate(rc=RC)
!
          MY_CHILDREN_ID=>cc%MY_CHILDREN_ID
          CHILD_ID=MY_CHILDREN_ID(N)
          CONFIG_ID=DOMAIN_ID_TO_RANK(CHILD_ID)
          WRITE(INT_TO_CHAR,FMT)CONFIG_ID
          CONFIG_FILE_NAME='configure_file_'//INT_TO_CHAR                  !<-- Prepare the config file names
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init1: Load Configure Files"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigLoadFile(config  =CF(N)                       &
                                  ,filename=CONFIG_FILE_NAME            &
                                  ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(RC/=0)THEN
            WRITE(0,*)' Parent unable to load child configure file '    &
                     ,TRIM(CONFIG_FILE_NAME)                            &
                     ,' in PARENT_CHILD_CPL_INITIALIZE1'
            WRITE(0,*)' ABORTING!'
            CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT               &
                              ,rc             =RC)
          ENDIF
!
!-----------------------------------------------------------------------
!***  Extract the children's domain sizes from the configure files.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Extract Global IM,JM of Child"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                     &  !<-- The child's config object
                                      ,value =IM_CHILD(N)               &  !<-- The variable filled (IM of child domain)
                                      ,label ='im:'                     &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                     &  !<-- The child's config object
                                      ,value =JM_CHILD(N)               &  !<-- The variable filled (JM of child domain)
                                      ,label ='jm:'                     &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Extract the children's boundary blending widths.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Parent-Child Init: Extract Child Bndry Blending Width"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                     &  !<-- The child's config object
                                      ,value =N_BLEND_H_CHILD(N)        &  !<-- The variable filled (N_BLEND_H of child domain N)
                                      ,label ='lnsh:'                   &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                     &  !<-- The child's config object
                                      ,value =N_BLEND_V_CHILD(N)        &  !<-- The variable filled (N_BLEND_V of child domain N)
                                      ,label ='lnsv:'                   &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(N_BLEND_V_CHILD(N)>N_BLEND_H_CHILD(N))THEN
            WRITE(0,*)' N_BLEND_V CANNOT EXCEED N_BLEND_H DUE TO PD AVERAGING!!!'
            WRITE(0,*)' ABORTING in child N=',N
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
!
!-----------------------------------------------------------------------
!***  Extract the integer ratio of parent-to-child grid increments.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Parent-to-Child Space Ratio"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                       &  !<-- The child's config object
                                      ,value =PARENT_CHILD_SPACE_RATIO(N) &  !<-- The variable filled (# of child grid inc's to parent's)
                                      ,label ='parent_child_space_ratio:' &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Use this ratio to compute an increment that is needed for
!***  selecting the appropriate nest tasks as mass values on the
!***  nest boundaries are averaged to the V points.  Its values
!***  are based on the nest grid increment distance from the
!***  southernmost V point on a nest's southernmost tasks to
!***  the nearest parent V point to the north.  Fractional values
!***  are increased to the next integer.
!-----------------------------------------------------------------------
!
          DIST_NESTV_SOUTH_TO_PARENTV_SOUTH=                            &
                                     (PARENT_CHILD_SPACE_RATIO(N)-1)*0.5
          INC_FIX(N)=INT(DIST_NESTV_SOUTH_TO_PARENTV_SOUTH+0.9)
!
!-----------------------------------------------------------------------
!***  Which of the children will be sending 2-way update data?  Save 
!***  their ranks in the list of all child ranks.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract the Child's Flag Indicating Nest Mode"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                       &  !<-- The child's config object
                                      ,value =NEST_MODE_CHILD(N)          &  !<-- The variable filled (does the child send 2-way data?)
                                      ,label ='nest_mode:'                &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          IF(NEST_MODE_CHILD(N)=='2-way')THEN
            NEST_MODE='2-way'
          ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!  
          IF(NEST_MODE_CHILD(N)=='2-way')THEN                                !<-- If true then this child sends 2-way update data.
!
            NUM_2WAY_CHILDREN=NUM_2WAY_CHILDREN+1                            !<-- Add up the # of 2-way children.
            RANK_2WAY_CHILD(NUM_2WAY_CHILDREN)=N                             !<-- Rank of 2-way children among all children.
!
          ENDIF 
!
!-----------------------------------------------------------------------
!***  Which of the children will be moving?  Save their ranks in
!***  the list of all children.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract the Child's Flag Indicating Movability"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                       &  !<-- The child's config object
                                      ,value =DOMAIN_MOVES                &  !<-- The variable filled (will the child move?)
                                      ,label ='my_domain_moves:'          &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!  
          IF(DOMAIN_MOVES)THEN                                               !<-- If true then child N moves.
!
            NUM_MOVING_CHILDREN=NUM_MOVING_CHILDREN+1                        !<-- Add up the # of moving children.
            RANK_MOVING_CHILD(NUM_MOVING_CHILDREN)=N                         !<-- Location in list of children of those who move.
            STATIC_OR_MOVING(N)='Moving'                                     !<-- Child N moves
!
          ENDIF 
!
!-----------------------------------------------------------------------
!***  We do not allow moving parents to have static children for now.
!-----------------------------------------------------------------------
!
          IF(MY_DOMAIN_MOVES)THEN
            IF(NUM_MOVING_CHILDREN/=NUM_CHILDREN)THEN
              WRITE(0,*)' You have specified a moving parent with'      &
                       ,' static children.  This is not allowed. '
              WRITE(0,*)' Moving parents can have only moving children.'
              WRITE(0,*)' Aborting!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
            ENDIF
!
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDDO child_info_loop
!
!-----------------------------------------------------------------------
!***  The number of 2-way children is a required argument in the 
!***  call to NMM_INTEGRATE therefore it must be known by the NMM
!***  component.  Insert it into the P-C coupler export state.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init1: Set # of 2-Way Children in P-C Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The P-C coupler's export state
                              ,name ='NUM_2WAY_CHILDREN'                &
                              ,value=NUM_2WAY_CHILDREN                  &  !<-- Current domain has this many 2-way children
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Allocate arrays/pointers needed by the parents to compute
!***  update data for their children.  The routine is called only
!***  by parents.
!-----------------------------------------------------------------------
!
        CALL PARENT_CHILD_INTERP_SETUP(MY_DOMAIN_ID                     &
                                      ,NUM_CHILDREN                     &
                                      ,MY_CHILDREN_ID                   &
                                      ,IM_CHILD                         &
                                      ,JM_CHILD                         &
                                      ,FTASKS_DOMAIN                    &
                                      ,N_BLEND_H_CHILD                  &
                                      ,N_BLEND_V_CHILD                  &
                                      ,CF                               &
                                      ,ITS,ITE,JTS,JTE                  &
                                      ,IDS,IDE,JDS,JDE )
!
!-----------------------------------------------------------------------
!***  The lead parent task now broadcasts the locations of the
!***  children's SW corner.  The lead tasks recvd this information 
!***  from the children in phase 0 of the P-C coupler initialize
!***  step (subroutine _INITIALIZE0).
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
!
          IF(I_AM_LEAD_FCST_TASK)THEN                                      !<-- Lead parent task clears IRecv in P-C Initialize0
            ID_CHILD=MY_CHILDREN_ID(N)                                     !<-- Child N's domain ID
            CALL MPI_WAIT(HANDLE_I_SW(ID_CHILD)                         &  !<-- Be sure the lead parent task has recvd child N's data.
                         ,JSTAT                                         &
                         ,IERR )
          ENDIF
!
          CALL MPI_BCAST(I_PARENT_SW(N)                                 &  !<-- Parent I of chkid N's SW corner
                        ,1                                              &  !<-- It is one word
                        ,MPI_INTEGER                                    &  !<-- Datatype
                        ,0                                              &  !<-- Lead parent task in parent-child intracomm is root
                        ,COMM_FCST_TASKS                                &  !<-- Intracommunicator for fcst tasks
                        ,IERR )
!
          IF(I_AM_LEAD_FCST_TASK)THEN                                      !<-- Lead parent task clears IRecv in P-C Initialize0
            ID_CHILD=MY_CHILDREN_ID(N)                                     !<-- Child N's domain ID
            CALL MPI_WAIT(HANDLE_J_SW(ID_CHILD)                         &  !<-- Be sure the lead parent task has recvd child N's data.
                         ,JSTAT                                         &
                         ,IERR )
          ENDIF
!
          CALL MPI_BCAST(J_PARENT_SW(N)                                 &  !<-- Parent J of chkid N's SW corner
                        ,1                                              &  !<-- It is one word
                        ,MPI_INTEGER                                    &  !<-- Datatype
                        ,0                                              &  !<-- Lead parent task in parent-child intracomm is root
                        ,COMM_FCST_TASKS                                &  !<-- Intracommunicator for fcst tasks
                        ,IERR )
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  We now compute various indices and weights needed by the parents
!***  to compute boundary data for their children.  It is here that
!***  location-dependent interpolation information is determined
!***  regarding the parent and nests.  Again only parents call this
!***  routine.
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
          CALL PREPARE_NEST_INTERP_FACTORS(N,MY_DOMAIN_ID)
        ENDDO
!
!-----------------------------------------------------------------------
!***  The parents need to send their children some key information
!***  regarding the association of child boundary tasks with parent
!***  tasks so the children know how to receive boundary data from
!***  their parents.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  MPI request handles for nonblocking sends in the following call
!***  to subroutine PARENT_SENDS_CHILD_DATA_LIMITS.
!-----------------------------------------------------------------------
!
        ALLOCATE(HANDLE_PACKET_S_H(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN) &
                ,stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,20001)MY_DOMAIN_ID,NUM_CHILDREN
20001     FORMAT(' Failed to allocate HANDLE_PACKET_S_H(',I2,')%CHILDREN(1:',I2,')')
          WRITE(0,*)' ISTAT=',ISTAT
          WRITE(0,*)' Aborting!'
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
        ALLOCATE(HANDLE_PACKET_S_V(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_N_H(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_N_V(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_W_H(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_W_V(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_E_H(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_PACKET_E_V(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
!
        DO N=1,NUM_CHILDREN
!
          ID_CHILD=MY_CHILDREN_ID(N)
          N1=0
          N2=FTASKS_DOMAIN(ID_CHILD)-1
          ALLOCATE(HANDLE_PACKET_S_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_S_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_N_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_N_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_W_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_W_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_E_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
          ALLOCATE(HANDLE_PACKET_E_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(N1:N2))
!
          DO NN=N1,N2
            HANDLE_PACKET_S_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_S_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_N_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_N_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_W_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_W_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_E_H(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
            HANDLE_PACKET_E_V(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN)=MPI_REQUEST_NULL
          ENDDO
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate unique memory locations for all of the data packets
!***  that parents will send to their children's tasks to inform
!***  them precisely which BC update data will be provided.
!-----------------------------------------------------------------------
!
        ALLOCATE(INFO_SEND(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate INFO_SEND%CHILDREN stat=',ISTAT
          WRITE(0,*)' Aborting!'
          CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
        ENDIF
!
        DO N=1,NUM_CHILDREN
!
          CHILD_ID=MY_CHILDREN_ID(N)
          ALLOCATE(INFO_SEND(MY_DOMAIN_ID)%CHILDREN(N)%INFO(1:6,0:FTASKS_DOMAIN(CHILD_ID)-1,1:8) &
                  ,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate INFO for n=',n,' child ID=',CHILD_ID,' stat=',ISTAT
            WRITE(0,*)' Aborting!'
            CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
          ENDIF
!
          DO N3=1,8
          DO N2=0,FTASKS_DOMAIN(CHILD_ID)-1
          DO N1=1,6
            INFO_SEND(MY_DOMAIN_ID)%CHILDREN(N)%INFO(N1,N2,N3)=-1  !<-- Initialize to invalid values
          ENDDO
          ENDDO
          ENDDO
!
          CALL PARENT_SENDS_CHILD_DATA_LIMITS(N,MY_DOMAIN_ID,'Future')
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate the pointers that will hold the surface geopotential
!***  of child tasks on each side of the child boundaries.  The child
!***  tasks of static nests will send that data to the appropriate
!***  parent tasks.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%FIS_CHILD_SOUTH(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%FIS_CHILD_SOUTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        ALLOCATE(cc%FIS_CHILD_NORTH(1:NUM_CHILDREN),stat=ISTAT)
        ALLOCATE(cc%FIS_CHILD_WEST(1:NUM_CHILDREN),stat=ISTAT)
        ALLOCATE(cc%FIS_CHILD_EAST(1:NUM_CHILDREN),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  The parent receives the child's boundary topography.  This
!***  is needed to maintain hydrostatic balance when parent data is
!***  interpolated to child boundaries where the terrain is different.
!-----------------------------------------------------------------------
!
        ALLOCATE(HANDLE_CHILD_TOPO_S(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_CHILD_TOPO_N(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_CHILD_TOPO_W(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
        ALLOCATE(HANDLE_CHILD_TOPO_E(MY_DOMAIN_ID)%CHILDREN(1:NUM_CHILDREN))
!
        DO N=1,NUM_CHILDREN
!
          HANDLE_CHILD_TOPO_S(MY_DOMAIN_ID)%CHILDREN(N)%DATA=>NULL()
          HANDLE_CHILD_TOPO_N(MY_DOMAIN_ID)%CHILDREN(N)%DATA=>NULL()
          HANDLE_CHILD_TOPO_W(MY_DOMAIN_ID)%CHILDREN(N)%DATA=>NULL()
          HANDLE_CHILD_TOPO_E(MY_DOMAIN_ID)%CHILDREN(N)%DATA=>NULL()
!
          CALL PARENT_RECVS_CHILD_TOPO(N,MY_DOMAIN_ID)
! 
        ENDDO
!
!-----------------------------------------------------------------------
!***  When the child's terrain is much lower than the parent's at
!***  locations where the parent generates BC data for the child then
!***  those values can be unrealistic due to the very large distance
!***  the parent must extrapolate under its own ground surface.  To 
!***  control this effect use the hyperbola Y=A/(X+A) to reduce the
!***  magnitude of the parent's underground extrapolation as the
!***  target depth increases.  The following call returns the value
!***  of the constant in the formula.  One point on the curve must be
!***  set by the user in subroutine HYPERBOLA in module_NESTING.
!-----------------------------------------------------------------------
!
        CALL HYPERBOLA(HYPER_A)
!
!-----------------------------------------------------------------------
!
        CHILDTASK_H_SAVE=>cc%CHILDTASK_H_SAVE
        CHILDTASK_BNDRY_H_RANKS=>cc%CHILDTASK_BNDRY_H_RANKS
        N_BLEND_H_CHILD=>cc%N_BLEND_H_CHILD
        COMM_TO_MY_CHILDREN=>cc%COMM_TO_MY_CHILDREN
        MY_CHILDREN_ID=>cc%MY_CHILDREN_ID
        MYPE=>cc%MYPE
!
        CALL MPI_COMM_RANK(COMM_TO_MY_CHILDREN(1),MYPE,IERR)               !<-- Obtain local rank of parent task in p-c intracomm
!
!-----------------------------------------------------------------------
!***  Parents send their children the parent domain limits and the
!***  integration limits of all forecast tasks on the parent domain.
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
!
          ALLOCATE(HANDLE_PARENT_DOM_LIMITS(MY_DOMAIN_ID)%DATA(1:NUM_CHILDREN))
          cc%MY_DOMAIN_LIMITS(1)=IDS
          cc%MY_DOMAIN_LIMITS(2)=IDE
          cc%MY_DOMAIN_LIMITS(3)=JDS
          cc%MY_DOMAIN_LIMITS(4)=JDE
!
          ALLOCATE(HANDLE_PARENT_ITS(MY_DOMAIN_ID)%DATA(1:NUM_CHILDREN) &
                  ,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate HANDLE_PARENT_ITS(',MY_DOMAIN_ID,')%DATA'
            WRITE(0,*)' Aborting!!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          ALLOCATE(HANDLE_PARENT_ITE(MY_DOMAIN_ID)%DATA(1:NUM_CHILDREN))
          ALLOCATE(HANDLE_PARENT_JTS(MY_DOMAIN_ID)%DATA(1:NUM_CHILDREN))
          ALLOCATE(HANDLE_PARENT_JTE(MY_DOMAIN_ID)%DATA(1:NUM_CHILDREN))
!
          DO N=1,NUM_CHILDREN
!
            CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(0)      !<-- Local rank of child N's lead task in parent-child intracomm
            NTAG=MY_CHILDREN_ID(N)*111+1
!
            HANDLE_PARENT_DOM_LIMITS(MY_DOMAIN_ID)%DATA(N)=MPI_REQUEST_NULL
!
            CALL MPI_ISSEND(cc%MY_DOMAIN_LIMITS                            &  !<-- Index limits of parent domain
                           ,4                                              &  !<-- There are 4 index limits
                           ,MPI_INTEGER                                    &  !<-- Indices are integers
                           ,CHILDTASK_0                                    &  !<-- Send to each child's task 0
                           ,NTAG                                           &  !<-- Unique MPI tag
                           ,COMM_TO_MY_CHILDREN(N)                         &  !<-- MPI intracommunicator to child N
                           ,HANDLE_PARENT_DOM_LIMITS(MY_DOMAIN_ID)%DATA(N) &  !<-- Request handle for this ISend
                           ,IERR )
!
            HANDLE_PARENT_ITS(MY_DOMAIN_ID)%DATA(N)=MPI_REQUEST_NULL
!
            CALL MPI_ISSEND(LOCAL_ISTART                                &  !<-- Starting I's of fcst tasks on parent domain
                           ,FTASKS_DOMAIN(MY_DOMAIN_ID)                 &  !<-- # of fcst tasks on parent domain
                           ,MPI_INTEGER                                 &  !<-- Indices are integers
                           ,CHILDTASK_0                                 &  !<-- Send to each child's task 0
                           ,NTAG                                        &  !<-- Unique MPI tag
                           ,COMM_TO_MY_CHILDREN(N)                      &  !<-- MPI intracommunicator to child N
                           ,HANDLE_PARENT_ITS(MY_DOMAIN_ID)%DATA(N)     &  !<-- Request handle for this ISend
                           ,IERR )
!
            NTAG=NTAG+1
            CALL MPI_ISSEND(LOCAL_JSTART                                &  !<-- Starting J's of fcst tasks on parent domain
                           ,FTASKS_DOMAIN(MY_DOMAIN_ID)                 &  !<-- # of fcst tasks on parent domain
                           ,MPI_INTEGER                                 &  !<-- Indices are integers
                           ,CHILDTASK_0                                 &  !<-- Send to each child's task 0
                           ,NTAG                                        &  !<-- Unique MPI tag
                           ,COMM_TO_MY_CHILDREN(N)                      &  !<-- MPI intracommunicator to child N
                           ,HANDLE_PARENT_JTS(MY_DOMAIN_ID)%DATA(N)     &  !<-- Request handle for this ISend
                           ,IERR )
!
            NTAG=NTAG+1
            CALL MPI_ISSEND(LOCAL_IEND                                  &  !<-- Ending I's of fcst tasks on parent domain
                           ,FTASKS_DOMAIN(MY_DOMAIN_ID)                 &  !<-- # of fcst tasks on parent domain
                           ,MPI_INTEGER                                 &  !<-- Indices are integers
                           ,CHILDTASK_0                                 &  !<-- Send to each child's task 0
                           ,NTAG                                        &  !<-- Unique MPI tag
                           ,COMM_TO_MY_CHILDREN(N)                      &  !<-- MPI intracommunicator to child N
                           ,HANDLE_PARENT_ITE(MY_DOMAIN_ID)%DATA(N)     &  !<-- Request handle for this ISend
                           ,IERR )
!
            NTAG=NTAG+1
            CALL MPI_ISSEND(LOCAL_JEND                                  &  !<-- Ending J's of fcst tasks on parent domain
                           ,FTASKS_DOMAIN(MY_DOMAIN_ID)                 &  !<-- # of fcst tasks on parent domain
                           ,MPI_INTEGER                                 &  !<-- Indices are integers
                           ,CHILDTASK_0                                 &  !<-- Send to each child's task 0
                           ,NTAG                                        &  !<-- Unique MPI tag
                           ,COMM_TO_MY_CHILDREN(N)                      &  !<-- MPI intracommunicator to child N
                           ,HANDLE_PARENT_JTE(MY_DOMAIN_ID)%DATA(N)     &  !<-- Request handle for this ISend
                           ,IERR )
!
          ENDDO
        ENDIF
!
!-----------------------------------------------------------------------
!***  If there are any 2-way children then allocate the top of the
!***  linked list that will hold specifications of each relevant
!***  child task's updating of a parent task's point.
!-----------------------------------------------------------------------
!
        IF(NUM_2WAY_CHILDREN>0)THEN
!
          ALLOCATE(cc%CHILD_TASKS_2WAY_UPDATE(1:NUM_2WAY_CHILDREN))
          DO N=1,NUM_2WAY_CHILDREN
            ALLOCATE(cc%CHILD_TASKS_2WAY_UPDATE(N)%TASK_ID)
            ALLOCATE(cc%CHILD_TASKS_2WAY_UPDATE(N)%NUM_PTS_UPDATE_HZ)
            ALLOCATE(cc%CHILD_TASKS_2WAY_UPDATE(N)%IL(1:2))
            ALLOCATE(cc%CHILD_TASKS_2WAY_UPDATE(N)%JL(1:2))
            cc%CHILD_TASKS_2WAY_UPDATE(N)%NEXT_LINK=>NULL()
          ENDDO
!
!-----------------------------------------------------------------------
!***  Initialize parent flag for its computing 2-way bookkeeping.
!-----------------------------------------------------------------------
!
          ALLOCATE(cc%CALLED_PARENT_2WAY_BOOKKEEPING(1:NUM_2WAY_CHILDREN))
          DO N=1,NUM_2WAY_CHILDREN
            cc%CALLED_PARENT_2WAY_BOOKKEEPING(N)=.FALSE.
          ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate the object that will keep track of the number of 
!***  tasks on each child that will provide 2-way exchange data
!***  to this parent task.
!-----------------------------------------------------------------------
!
          ALLOCATE(cc%NTASKS_UPDATE_CHILD(1:NUM_2WAY_CHILDREN))
          DO N=1,NUM_2WAY_CHILDREN
            cc%NTASKS_UPDATE_CHILD(N)=0
          ENDDO
!
!-----------------------------------------------------------------------
!***  Each 2-way nest can have its own weight used in blending the
!***  child's update values with the parents' pre-update values.
!-----------------------------------------------------------------------
!
          ALLOCATE(cc%CHILD_2WAY_WGT(1:NUM_2WAY_CHILDREN))
          DO N=1,NUM_2WAY_CHILDREN
            cc%CHILD_2WAY_WGT(N)=-99999.
          ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate the stencils used for averaging a child's data to 
!***  its parent's grid.
!-----------------------------------------------------------------------
!
          ALLOCATE(cc%N_STENCIL_H_CHILD(1:NUM_2WAY_CHILDREN))
          ALLOCATE(cc%N_STENCIL_v_CHILD(1:NUM_2WAY_CHILDREN))
          ALLOCATE(cc%N_STENCIL_SFC_H_CHILD(1:NUM_2WAY_CHILDREN))
          ALLOCATE(cc%N_STENCIL_SFC_V_CHILD(1:NUM_2WAY_CHILDREN))
!
          N_STENCIL_H_CHILD=>cc%N_STENCIL_H_CHILD
          N_STENCIL_V_CHILD=>cc%N_STENCIL_V_CHILD
          N_STENCIL_SFC_H_CHILD=>cc%N_STENCIL_SFC_H_CHILD
          N_STENCIL_SFC_V_CHILD=>cc%N_STENCIL_SFC_V_CHILD
!
          DO N=1,NUM_2WAY_CHILDREN
            cc%N_STENCIL_H_CHILD(N)=-99999.
            cc%N_STENCIL_V_CHILD(N)=-99999.
            cc%N_STENCIL_SFC_H_CHILD(N)=-99999.
            cc%N_STENCIL_SFC_V_CHILD(N)=-99999.
          ENDDO
!
!-----------------------------------------------------------------------
!***  Set the 2-way children's averaging weights.  When a child
!***  updates its parent's points the final value is a blend of the
!***  child's interpolated value and the parent's own incoming value.
!-----------------------------------------------------------------------
!
          NN=0
!
!-----------------------------------------------------------------------
!
          DO N=1,NUM_CHILDREN
!
!-----------------------------------------------------------------------
!
            IF(NEST_MODE_CHILD(N)=='2-way')THEN
              NN=NN+1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              MESSAGE_CHECK="Extract the Child's 2-Way Weight"
!             CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              CALL ESMF_ConfigGetAttribute(config=CF(N)                 &  !<-- The child's config object
                                          ,value =cc%CHILD_2WAY_WGT(NN) &  !<-- Child domain's weight in 2-way updates.
                                          ,label ='2way_wgt:'           &  !<-- Give this label's value to the previous variable
                                          ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!  
!-----------------------------------------------------------------------
!***  Set the children's 2-way averaging widths for H and V points.
!-----------------------------------------------------------------------
!
              IF(MOD(PARENT_CHILD_SPACE_RATIO(N),2)==1)THEN
                N_STENCIL_H_CHILD(N)=STENCIL_H_ODD
                N_STENCIL_V_CHILD(N)=STENCIL_V_ODD
                N_STENCIL_SFC_H_CHILD(N)=STENCIL_SFC_H_ODD
                N_STENCIL_SFC_V_CHILD(N)=STENCIL_SFC_V_ODD
              ELSE
                N_STENCIL_H_CHILD(N)=STENCIL_H_EVEN
                N_STENCIL_V_CHILD(N)=STENCIL_V_EVEN
                N_STENCIL_SFC_H_CHILD(N)=STENCIL_SFC_H_EVEN
                N_STENCIL_SFC_V_CHILD(N)=STENCIL_SFC_V_EVEN
              ENDIF
!
            ENDIF
!
!-----------------------------------------------------------------------
!
          ENDDO
!
!-----------------------------------------------------------------------
!  
        ENDIF
!
        DEALLOCATE(NEST_MODE_CHILD)
!
!-----------------------------------------------------------------------
!***  Allocate the Handle for use by moving parents in ISends of their
!***  shift information to their children.  
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
          ALLOCATE(cc%HANDLE_PARENT_SHIFT(1:NUM_CHILDREN))
          DO N=1,NUM_CHILDREN
            cc%HANDLE_PARENT_SHIFT(N)=MPI_REQUEST_NULL
          ENDDO
        ENDIF
!
!-----------------------------------------------------------------------
!***  If a moving child comes too close to its parent's boundary
!***  then the parent must move to avoid the collision.  Initialize
!***  the flag and shift array.
!-----------------------------------------------------------------------
!
        cc%CHILD_FORCES_MY_SHIFT=.FALSE.
        cc%MY_FORCED_SHIFT(1)=-99999
        cc%MY_FORCED_SHIFT(2)=-99999
!
        DO N=1,3
          cc%PARENT_SHIFT(N)=-999
        ENDDO
!
!-----------------------------------------------------------------------
!
      ENDIF parent_block_1
!
!-----------------------------------------------------------------------
!***  All domains want to know what their very last timestep is
!***  in the forecast.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Parent-Child Init1: Get Forecast Length"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF_MINE                       &  !<-- This domain's configure object
                                  ,value =NHOURS_FCST                   &  !<-- The # of hours in the forecast
                                  ,label ='nhours_fcst:'                &  !<-- Give this label's value to the previous variable
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%NTIMESTEP_FINAL=NHOURS_FCST*3600./DT_DOMAIN(MY_DOMAIN_ID)-1       !<-- This domain's final timestep in the forecast
!
!-----------------------------------------------------------------------
!***  If there is digital filtering does this domain participate?
!***  Currently a nest must be static and 1-way for this to be
!***  considered.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init1: Extract domain DFI flag from P-C cpl imp state"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='I Am Active'                        &  !<-- Name of Attribute to extract
                            ,value=I_AM_ACTIVE                          &  !<-- Does domain participate in digital filtering?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Insert the flag indicating digital filter activity into the
!***  P-C coupler export state.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init1: Insert DFI activity flag into P-C Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The P-C coupler's export state
                            ,name ='I Am Active'                        &
                            ,value=I_AM_ACTIVE                          &  !<-- Does this domain execute the digital filter?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      IF(NUM_CHILDREN>0)THEN

! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract child DFI flags from P-C cpl import state"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =IMP_STATE                      &  !<-- The parent-child coupler import state
                              ,name     ='Child Active'                 &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of items in the Attribute
                              ,valueList=CHILD_ACTIVE                   &  !<-- Which children participate in digital filtering?
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Insert child DFI flags into P-C cpl export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =EXP_STATE                      &  !<-- This Parent_child Coupler export state
                              ,name     ='Child Active'                 &  !<-- Name of the attribute to extract
                              ,itemCount=NUM_CHILDREN                   &  !<-- # of words in the data
                              ,valueList=CHILD_ACTIVE                   &  !<-- Which children participate in digital filtering?
                              ,rc       =RC)
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(RC_CPL_INIT==ESMF_SUCCESS)THEN
!       WRITE(0,*)"PARENT_CHILD_CPL INITIALIZE STEP SUCCEEDED"
      ELSE
        WRITE(0,*)"PARENT_CHILD_CPL INITIALIZE STEP FAILED"
      ENDIF
!
      RC_FINAL=RC_CPL_INIT
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_CPL_INITIALIZE1
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_CPL_INITIALIZE2(CPL_COMP                  &
                                             ,IMP_STATE                 &
                                             ,EXP_STATE                 &
                                             ,CLOCK                     &
                                             ,RC_FINAL)   
!
!-----------------------------------------------------------------------
!***  Perform final work needed by the Parent-Child coupler.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: CONFIG_ID                                   &
                           ,ID_CHILD,KR                                 &
                           ,MINUTES_RESTART,MY_DOMAIN_ID                &
                           ,N,N_FIELD,N_MOVING,N1,N2,NN                 &
                           ,NROWS_P_UPD_X,NTAG,NTIMESTEP                &
                           ,NUM_CHILD_TASKS,NUM_DIMS,NV                 &
                           ,SFC_FILE_RATIO,UPDATE_TYPE_INT
!
      INTEGER(kind=KINT) :: IERR,ISTAT,RC,RC_CPL_INIT
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER(kind=KINT),DIMENSION(1:3) :: LIMITS_LO,LIMITS_HI
!
      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      REAL(kind=KFPT) :: DPH_1,DLM_1                                    &
                        ,SBD_1,WBD_1                                    &
                        ,TPH0D_1,TLM0D_1
!
      REAL(kind=KFPT) :: LATITUDE_LIMIT
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: DUMMY_3D=>NULL()
!
      REAL(kind=DOUBLE) :: D2R,D_ONE,D_180,FACTOR1,FACTOR2,PI
!
      LOGICAL(kind=KLOG) :: FOUND
!
      LOGICAL(kind=KLOG) :: I_AM_A_NEST                                 &
                           ,INTEGRATE_TIMESTEP
!
      CHARACTER(len=1) :: UPDATE_TYPE_CHAR
      CHARACTER(len=2) :: INT_TO_CHAR
      CHARACTER(len=6) :: FMT='(I2.2)'
      CHARACTER(len=99) :: FIELD_NAME
!
      TYPE(COMPOSITE),POINTER :: CC
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC         =ESMF_SUCCESS
      RC_FINAL   =ESMF_SUCCESS
      RC_CPL_INIT=ESMF_SUCCESS
!
!----------------------
!***  This domain's ID
!----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init2: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Point to this domain's values in the composite object.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)                                      !<-- Use dummy for shorter reference to composite
!
!-----------------------------------------------------------------------
!
      NUM_CHILDREN=>cc%NUM_CHILDREN                                        !<-- How many children does this domain have?
!
      D_ONE=1.
      D_180=180.
      PI=DACOS(-D_ONE)
      D2R=PI/D_180
!
!-----------------------------------------------------------------------
!***  Begin the work of the parents.
!-----------------------------------------------------------------------
!
      parent_block_2: IF(NUM_CHILDREN>0)THEN
!
!-----------------------------------------------------------------------
!***  Allocate arrays for the parents' tracking of when children have
!***  data ready to send in 2-way nesting.  Also initialize the flag
!***  that allows DOMAIN_RUN to always be called during the first 
!***  pass through NMM_INTEGRATE.  For 1-way nesting the flag will
!***  remain TRUE and never be reset.
!-----------------------------------------------------------------------
!
        IF(NUM_2WAY_CHILDREN>0)THEN
          ALLOCATE(cc%SIGNAL_2WAY_SEND_READY(1:NUM_2WAY_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%SIGNAL_2WAY_SEND_READY stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          SIGNAL_2WAY_SEND_READY=>cc%SIGNAL_2WAY_SEND_READY
!
          DO N=1,NUM_2WAY_CHILDREN
            SIGNAL_2WAY_SEND_READY(N)=.FALSE.
          ENDDO
!
          ALLOCATE(cc%SKIP_2WAY_UPDATE(1:NUM_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%SKIP_2WAY_UPDATE stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          SKIP_2WAY_UPDATE=>cc%SKIP_2WAY_UPDATE
!
          DO N=1,NUM_CHILDREN
            SKIP_2WAY_UPDATE(N)=.FALSE.
          ENDDO
!
        ENDIF
!
        ALLOCATE(cc%HANDLE_SEND_ALLCLEAR(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%HANDLE_SEND_ALLCLEAR stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        HANDLE_SEND_ALLCLEAR=>cc%HANDLE_SEND_ALLCLEAR
!
        DO N=1,NUM_CHILDREN
          HANDLE_SEND_ALLCLEAR(N)=MPI_REQUEST_NULL
        ENDDO
!
        cc%KOUNT_2WAY_CHILDREN=0
!
        cc%FIRST_CALL_RECV_2WAY=.TRUE.
        INTEGRATE_TIMESTEP=.TRUE.
        cc%RECV_ALL_CHILD_DATA=.TRUE.
!
        RECV_ALL_CHILD_DATA=>cc%RECV_ALL_CHILD_DATA
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init2: Set Integrate Flag"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The P-C coupler's export state
                              ,name ='Integrate Flag'                   &
                              ,value=INTEGRATE_TIMESTEP                 &
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init2: Set Recv Flag for Child Data"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The P-C coupler's export state
                              ,name ='Recv All Child Data'              &
                              ,value=RECV_ALL_CHILD_DATA                &
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Write/quilt tasks return now since the rest of the routine
!***  is directly or indirectly related to the grid.
!-----------------------------------------------------------------------
!
        IF(.NOT.I_AM_A_FCST_TASK)RETURN
!
!-----------------------------------------------------------------------
!***  Allocate the pointers that will hold all of the interpolated
!***  boundary data for the child tasks if the parent task contains
!***  child boundary points on the four sides.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  The data pointer within the CHILD_BOUND_* arrays will
!***  hold the boundary data of each child tasks' boundary data in a 
!***  1-D string that will be used to send the data from the parent
!***  to the child tasks.  The *_B_* arrays are what will be sent
!***  into subroutine PARENT_TO_CHILD_BNDRY_COMPUTE where the
!***  actual computations of the boundary data are carried out.
!***  The unallocated subcomponents of the *_B_* arrays are filled
!***  by the routine and thus the 1-D string will automatically
!***  be filled and ready for sending to each child task that contains
!***  boundary points.
!
!***  NOTE the heirarchy of the derived data variables' pointers
!***  that hold the boundary data: 
!
!***  (1) Primary variable dimensioned 1-D over the children.
!***  (2) For each child, TASKS is dimensioned 1-D over the given
!***      child's tasks that contain segments of boundary on the
!***      parent task.
!***  (3) For each child task, DATA is dimensioned 1-D since 
!***      1-D strings are required for MPI Send/Recv.
!***      (a) The 1-D CHILD_BOUND_* DATA pointers are allocated
!***          and are filled with the child boundary data destined
!***          for each individual child task that contains any 
!***          segment of a child's boundary on a given parent
!***          task.
!***      (b) The specific boundary variables (T_B_*, Q_B_*, etc.)
!***          DATA subcomponent pointers are declared but never
!***          allocated and instead are simply pointed into the
!***          allocated 1-D CHILD_BOUND_* DATA subcomponent pointer.
!***          These specific boundary variables are sent into the
!***          subroutine where the child boundary data is computed
!***          which then leads to the allocated CHILD_BOUND_* 1-D
!***          DATA pointer being filled automatically.  Thus the
!***          allocated 1-D pointer is immediately ready for subsequent
!***          sending to child tasks.
!***          The subcomponent pointer for PD_B_* though must be
!***          allocated.  That is because it contains values one row
!***          beyond those actually needed to be sent to the child
!***          tasks to update their boundary values of PD.  That 
!***          extra row is used to do 4-pt averaging to obtain PD
!***          on V points within the nests' boundary regions which
!***          is needed to do the hydrostatic updating of the winds
!***          there.  So the PD_B sections of the full 1-D DATA
!***          pointer CHILD_BOUND_* that is actually sent from
!***          parents to children must be filled explicitly inside
!***          subroutine PARENT_UPDATE_CHILD_PSFC.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%CHILD_BOUND_H_SOUTH(1:NUM_CHILDREN,1:2),stat=ISTAT)    !<-- 1-D bndry data string for child tasks with Sbndry H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_BOUND_H_SOUTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_BOUND_H_SOUTH=>cc%CHILD_BOUND_H_SOUTH
!
        ALLOCATE(cc%CHILD_BOUND_V_SOUTH(1:NUM_CHILDREN,1:2),stat=ISTAT)    !<-- 1-D bndry data string for child tasks with Sbndry V points
        CHILD_BOUND_V_SOUTH=>cc%CHILD_BOUND_V_SOUTH
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%WORDS_BOUND_H_SOUTH(1:NUM_CHILDREN),stat=ISTAT)        !<-- # of words in Sbndry H point 1-D data string
        WORDS_BOUND_H_SOUTH=>cc%WORDS_BOUND_H_SOUTH
!
        ALLOCATE(cc%WORDS_BOUND_V_SOUTH(1:NUM_CHILDREN),stat=ISTAT)        !<-- # of words in Sbndry V point 1-D data string
        WORDS_BOUND_V_SOUTH=>cc%WORDS_BOUND_V_SOUTH
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%PD_B_SOUTH(1:NUM_CHILDREN),stat=ISTAT)                 !<-- South boundary PD on H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%PD_B_SOUTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        PD_B_SOUTH=>cc%PD_B_SOUTH
!
        ALLOCATE(cc%PD_B_SOUTH_V(1:NUM_CHILDREN),stat=ISTAT)               !<-- South boundary PD on V points
        PD_B_SOUTH_V=>cc%PD_B_SOUTH_V
!
!-----------------------------------------------------------------------
!***  Allocate the working objects used by the parents for H-pt
!***  update variables on the nest boundaries.  Exclude PD since
!***  it must be handled separately (thus the '-1' in the allocates).
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%BND_VAR_H_SOUTH(1:NVARS_NESTBC_H-1),stat=ISTAT)
        IF(ISTAT>0)THEN
          WRITE(0,11001)NVARS_NESTBC_H-1,ISTAT
11001     FORMAT(' P-C Init2 failed to allocate BND_VAR_H_SOUTH(1:',I2,') istat=',i3)
        ENDIF
        ALLOCATE(cc%BND_VAR_H_NORTH(1:NVARS_NESTBC_H-1),stat=ISTAT)
        ALLOCATE(cc%BND_VAR_H_WEST (1:NVARS_NESTBC_H-1),stat=ISTAT)
        ALLOCATE(cc%BND_VAR_H_EAST (1:NVARS_NESTBC_H-1),stat=ISTAT)
!
        DO NV=1,NVARS_NESTBC_H-1 
          ALLOCATE(cc%BND_VAR_H_SOUTH(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          IF(ISTAT>0)THEN
            WRITE(0,11011)NV,NUM_CHILDREN,ISTAT
11011       FORMAT(' P-C Init2 failed to allocate BND_VAR_H_SOUTH(',I2,')%CHILD(1:',I2,') istat=',i3)
          ENDIF
          ALLOCATE(cc%BND_VAR_H_NORTH(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          ALLOCATE(cc%BND_VAR_H_WEST(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          ALLOCATE(cc%BND_VAR_H_EAST(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
        ENDDO
!
        BND_VAR_H_SOUTH=>cc%BND_VAR_H_SOUTH
        BND_VAR_H_NORTH=>cc%BND_VAR_H_NORTH
        BND_VAR_H_WEST =>cc%BND_VAR_H_WEST
        BND_VAR_H_EAST =>cc%BND_VAR_H_EAST
!
!-----------------------------------------------------------------------
!***  Allocate the working objects used by the parents for V-pt
!***  update variables on the nest boundaries.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%BND_VAR_V_SOUTH(1:NVARS_NESTBC_V),stat=ISTAT)
        ALLOCATE(cc%BND_VAR_V_NORTH(1:NVARS_NESTBC_V),stat=ISTAT)
        ALLOCATE(cc%BND_VAR_V_WEST (1:NVARS_NESTBC_V),stat=ISTAT)
        ALLOCATE(cc%BND_VAR_V_EAST (1:NVARS_NESTBC_V),stat=ISTAT)
!
        DO NV=1,NVARS_NESTBC_V
          ALLOCATE(cc%BND_VAR_V_SOUTH(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          ALLOCATE(cc%BND_VAR_V_NORTH(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          ALLOCATE(cc%BND_VAR_V_WEST(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
          ALLOCATE(cc%BND_VAR_V_EAST(NV)%CHILD(1:NUM_CHILDREN),stat=ISTAT)
        ENDDO
!
        BND_VAR_V_SOUTH=>cc%BND_VAR_V_SOUTH
        BND_VAR_V_NORTH=>cc%BND_VAR_V_NORTH
        BND_VAR_V_WEST =>cc%BND_VAR_V_WEST
        BND_VAR_V_EAST =>cc%BND_VAR_V_EAST
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%CHILD_BOUND_H_NORTH(1:NUM_CHILDREN,1:2),stat=ISTAT)    !<-- 1-D bndry data string for child tasks with Nbndry H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_BOUND_H_NORTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_BOUND_H_NORTH=>cc%CHILD_BOUND_H_NORTH
!
        ALLOCATE(cc%CHILD_BOUND_V_NORTH(1:NUM_CHILDREN,1:2),stat=ISTAT)    !<-- 1-D bndry data string for child tasks with Nbndry V points
        CHILD_BOUND_V_NORTH=>cc%CHILD_BOUND_V_NORTH
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%WORDS_BOUND_H_NORTH(1:NUM_CHILDREN),stat=ISTAT)        !<-- # of words in Nbndry H point 1-D data string
        WORDS_BOUND_H_NORTH=>cc%WORDS_BOUND_H_NORTH
!
        ALLOCATE(cc%WORDS_BOUND_V_NORTH(1:NUM_CHILDREN),stat=ISTAT)        !<-- # of words in Nbndry V point 1-D data string
        WORDS_BOUND_V_NORTH=>cc%WORDS_BOUND_V_NORTH
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%PD_B_NORTH(1:NUM_CHILDREN),stat=ISTAT)                 !<-- North boundary PD on H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%PD_B_NORTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        PD_B_NORTH=>cc%PD_B_NORTH
!
        ALLOCATE(cc%PD_B_NORTH_V(1:NUM_CHILDREN),stat=ISTAT)               !<-- North boundary PD on V points
        PD_B_NORTH_V=>cc%PD_B_NORTH_V
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%CHILD_BOUND_H_WEST(1:NUM_CHILDREN,1:2),stat=ISTAT)     !<-- 1-D bndry data string for child tasks with Wbndry H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_BOUND_H_WEST stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_BOUND_H_WEST=>cc%CHILD_BOUND_H_WEST
!
        ALLOCATE(cc%CHILD_BOUND_V_WEST(1:NUM_CHILDREN,1:2),stat=ISTAT)     !<-- 1-D bndry data string for child tasks with Wbndry V points
        CHILD_BOUND_V_WEST=>cc%CHILD_BOUND_V_WEST
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%WORDS_BOUND_H_WEST(1:NUM_CHILDREN),stat=ISTAT)         !<-- # of words in Wbndry H point 1-D data string
        WORDS_BOUND_H_WEST=>cc%WORDS_BOUND_H_WEST
!
        ALLOCATE(cc%WORDS_BOUND_V_WEST(1:NUM_CHILDREN),stat=ISTAT)         !<-- # of words in Wbndry V point 1-D data string
        WORDS_BOUND_V_WEST=>cc%WORDS_BOUND_V_WEST
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%PD_B_WEST(1:NUM_CHILDREN),stat=ISTAT)                  !<-- West boundary PD on H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%PD_B_WEST stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        PD_B_WEST=>cc%PD_B_WEST
!
        ALLOCATE(cc%PD_B_WEST_V(1:NUM_CHILDREN),stat=ISTAT)                !<-- West boundary PD on V points
        PD_B_WEST_V=>cc%PD_B_WEST_V
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%CHILD_BOUND_H_EAST(1:NUM_CHILDREN,1:2),stat=ISTAT)     !<-- 1-D bndry data string for child tasks with Ebndry H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%CHILD_BOUND_H_EAST stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        CHILD_BOUND_H_EAST=>cc%CHILD_BOUND_H_EAST
!
        ALLOCATE(cc%CHILD_BOUND_V_EAST(1:NUM_CHILDREN,1:2),stat=ISTAT)     !<-- 1-D bndry data string for child tasks with Ebndry V points
        CHILD_BOUND_V_EAST=>cc%CHILD_BOUND_V_EAST
!
        ALLOCATE(cc%WORDS_BOUND_H_EAST(1:NUM_CHILDREN),stat=ISTAT)         !<-- # of words in Ebndry H point 1-D data string
        WORDS_BOUND_H_EAST=>cc%WORDS_BOUND_H_EAST
!
        ALLOCATE(cc%WORDS_BOUND_V_EAST(1:NUM_CHILDREN),stat=ISTAT)         !<-- # of words in Ebndry V point 1-D data string
        WORDS_BOUND_V_EAST=>cc%WORDS_BOUND_V_EAST
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%PD_B_EAST(1:NUM_CHILDREN),stat=ISTAT)                  !<-- East boundary PD on H points
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%PD_B_EAST stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        PD_B_EAST=>cc%PD_B_EAST
!
        ALLOCATE(cc%PD_B_EAST_V(1:NUM_CHILDREN),stat=ISTAT)                !<-- East boundary PD on V points
        PD_B_EAST_V=>cc%PD_B_EAST_V
!
        DO NN=1,2
          DO N=1,NUM_CHILDREN
            CHILD_BOUND_H_SOUTH(N,NN)%TASKS=>NULL()
            CHILD_BOUND_H_NORTH(N,NN)%TASKS=>NULL()
            CHILD_BOUND_H_WEST(N,NN)%TASKS=>NULL()
            CHILD_BOUND_H_EAST(N,NN)%TASKS=>NULL()
          ENDDO
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate dummy subcomponents for the working pointers for (N,2)
!***  which correspond to values used when parents must send BC data
!***  to a nest immediately after it has moved, i.e., for that nest's
!***  current time and not for its future time.  Pointers for (N,1)
!***  will always be allocated ahead of deallocation since they are
!***  continually needed for the parent's sending BC data to all the
!***  nests from their future.
!***  In the normal sequence these working pointers are deallocated
!***  each time a nest moves so that they can be reallocated properly
!***  for the given association of parent and nest tasks.  Therefore
!***  they must be allocated already for the deallocations that take
!***  place with each nest's first move.
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
!
          ALLOCATE(CHILD_BOUND_H_SOUTH(N,2)%TASKS(1))      
          ALLOCATE(CHILD_BOUND_V_SOUTH(N,2)%TASKS(1))      
          CHILD_BOUND_H_SOUTH(N,2)%TASKS(1)%DATA=>NULL()
          CHILD_BOUND_V_SOUTH(N,2)%TASKS(1)%DATA=>NULL()
!
          ALLOCATE(CHILD_BOUND_H_NORTH(N,2)%TASKS(1))      
          ALLOCATE(CHILD_BOUND_V_NORTH(N,2)%TASKS(1))      
          CHILD_BOUND_H_NORTH(N,2)%TASKS(1)%DATA=>NULL()
          CHILD_BOUND_V_NORTH(N,2)%TASKS(1)%DATA=>NULL()
!
          ALLOCATE(CHILD_BOUND_H_WEST(N,2)%TASKS(1))      
          ALLOCATE(CHILD_BOUND_V_WEST(N,2)%TASKS(1))      
          CHILD_BOUND_H_WEST(N,2)%TASKS(1)%DATA=>NULL()
          CHILD_BOUND_V_WEST(N,2)%TASKS(1)%DATA=>NULL()
!
          ALLOCATE(CHILD_BOUND_H_EAST(N,2)%TASKS(1))      
          ALLOCATE(CHILD_BOUND_V_EAST(N,2)%TASKS(1))      
          CHILD_BOUND_H_EAST(N,2)%TASKS(1)%DATA=>NULL()
          CHILD_BOUND_V_EAST(N,2)%TASKS(1)%DATA=>NULL()
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate logical flags indicating if parent task holds any
!***  child boundary points for the purpose of sending that data
!***  to pertinent child tasks.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%SEND_CHILD_DATA(1:NUM_CHILDREN),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%SEND_CHILD_DATA stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        SEND_CHILD_DATA=>cc%SEND_CHILD_DATA
!
!-----------------------------------------------------------------------
!***  Allocate the handles to be used by parent tasks when they ISend
!***  data directly to the appropiate child boundary tasks.  The 2nd
!***  dimension is 2 because these handles are used in two different
!***  and essentially independent situations.  The first is when the
!***  parents send their children the usual boundary updates from the
!***  children's future so that the children can compute time tendencies
!***  for their integration through the next parent timestep.  The
!***  second is when parents send their moving children the same set
!***  of boundary values that they will receive at one of their
!***  current timesteps immediately after they move to a new location.
!***  Those values will serve as the time N values in the subsequent
!***  tendency computations for variable X: [X(N+1)-X(N)]/DT(parent)
!***  Note that while the 2nd dimension of all children is 2, the
!***  Handles' subcomponents associated with that index's value of 2
!***  will be allocated and used only for moving nests.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%HANDLE_H_SOUTH(1:NUM_CHILDREN,1:2),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%HANDLE_H_SOUTH stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        HANDLE_H_SOUTH=>cc%HANDLE_H_SOUTH
!
        ALLOCATE(cc%HANDLE_H_NORTH(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_H_NORTH=>cc%HANDLE_H_NORTH
!
        ALLOCATE(cc%HANDLE_H_WEST(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_H_WEST=>cc%HANDLE_H_WEST
!
        ALLOCATE(cc%HANDLE_H_EAST(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_H_EAST=>cc%HANDLE_H_EAST
!
        ALLOCATE(cc%HANDLE_V_SOUTH(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_V_SOUTH=>cc%HANDLE_V_SOUTH
!
        ALLOCATE(cc%HANDLE_V_NORTH(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_V_NORTH=>cc%HANDLE_V_NORTH
!
        ALLOCATE(cc%HANDLE_V_WEST(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_V_WEST=>cc%HANDLE_V_WEST
!
        ALLOCATE(cc%HANDLE_V_EAST(1:NUM_CHILDREN,1:2),stat=ISTAT)
        HANDLE_V_EAST=>cc%HANDLE_V_EAST
!
        DO N=1,NUM_CHILDREN
!
          ALLOCATE(HANDLE_H_SOUTH(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_V_SOUTH(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_H_NORTH(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_V_NORTH(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_H_WEST(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_V_WEST(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_H_EAST(N,2)%NTASKS_TO_RECV(1))
          ALLOCATE(HANDLE_V_EAST(N,2)%NTASKS_TO_RECV(1))
!
          HANDLE_H_SOUTH(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_V_SOUTH(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_H_NORTH(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_V_NORTH(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_H_WEST(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_V_WEST(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_H_EAST(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
          HANDLE_V_EAST(N,2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Point unallocated working pointers of parent's interpolated data
!***  into the allocated composite pointer holding all boundary data
!***  to be sent to each child from their future.
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
          CALL POINT_INTERP_DATA_TO_MEMORY(N,MY_DOMAIN_ID,'Future')
        ENDDO
!
!-----------------------------------------------------------------------
!***  Allocate an array of logical flags the parent will use for its
!***  moving children to know when they want to move.
!***  Also allocate the composite data object that will hold all of
!***  the update data the parent sends to its moving children and
!***  the associated Handles for the ISends.
!-----------------------------------------------------------------------
!
        IF(NUM_MOVING_CHILDREN>0)THEN
          ALLOCATE(cc%MOVE_FLAG(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%MOVE_FLAG stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          MOVE_FLAG=>cc%MOVE_FLAG
          MY_CHILDREN_ID=>cc%MY_CHILDREN_ID
!
          ALLOCATE(cc%HANDLE_BC_UPDATE(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%HANDLE_BC_UPDATE stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          HANDLE_BC_UPDATE=>cc%HANDLE_BC_UPDATE
!
          ALLOCATE(cc%HANDLE_TIMESTEP(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%HANDLE_TIMESTEP stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          HANDLE_TIMESTEP=>cc%HANDLE_TIMESTEP
!
          ALLOCATE(cc%HANDLE_MOVE_DATA(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%HANDLE_MOVE_DATA stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          HANDLE_MOVE_DATA=>cc%HANDLE_MOVE_DATA
!
          DO N=1,NUM_MOVING_CHILDREN
            MOVE_FLAG(N)       =.FALSE.
            HANDLE_BC_UPDATE(N)=MPI_REQUEST_NULL
            HANDLE_TIMESTEP(N) =MPI_REQUEST_NULL
!
            N_MOVING=RANK_MOVING_CHILD(N)
            NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N_MOVING))
            ALLOCATE(HANDLE_MOVE_DATA(N)%NTASKS_TO_RECV(1:NUM_CHILD_TASKS))
!
            DO NN=1,NUM_CHILD_TASKS
              HANDLE_MOVE_DATA(N)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
            ENDDO
          ENDDO
!
          ALLOCATE(cc%TASK_UPDATE_SPECS(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%TASK_UPDATE_SPECS stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          TASK_UPDATE_SPECS=>cc%TASK_UPDATE_SPECS
!
          ALLOCATE(cc%MOVING_CHILD_UPDATE(1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%MOVING_CHILD_UPDATE stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          MOVING_CHILD_UPDATE=>cc%MOVING_CHILD_UPDATE
!
          DO N=1,NUM_MOVING_CHILDREN
            TASK_UPDATE_SPECS(N)%TASK_ID=>NULL()
            TASK_UPDATE_SPECS(N)%NUM_PTS_UPDATE_HZ=>NULL()
            TASK_UPDATE_SPECS(N)%NEXT_LINK=>NULL()
            MOVING_CHILD_UPDATE(N)%TASKS=>NULL()
          ENDDO
!
          ALLOCATE(cc%SHIFT_INFO_CHILDREN(1:4,1:NUM_MOVING_CHILDREN),stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' Failed to allocate cpl_composite%SHIFT_INFO_CHILDREN stat=',ISTAT
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
          SHIFT_INFO_CHILDREN=>cc%SHIFT_INFO_CHILDREN
!
          DO N2=1,NUM_MOVING_CHILDREN
          DO N1=1,4
            SHIFT_INFO_CHILDREN(N1,N2)=0
          ENDDO
          ENDDO
!
!-----------------------------------------------------------------------
!***  If this is a restarted run then take the value of the children's
!***  next move timestep from the import state (the values having
!***  originated from the Solver's read of the restart file).
!-----------------------------------------------------------------------
!
          IF(RESTART)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init2: Get Next Move Timestep of Children for Restart"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_AttributeGet(state    =IMP_STATE                    &  !<-- The Parent-Child coupler import state
                                  ,name     ='NEXT_TIMESTEP_CHILD_MOVES'  &  !<-- Name in import state
                                  ,valueList=cc%NTIMESTEP_CHILD_MOVES     &  !<-- The next timestep the moving children move
                                  ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!
        cc%NCYCLE_PARENT=0
!
!-----------------------------------------------------------------------
!
      ENDIF parent_block_2
!
!-----------------------------------------------------------------------
!***  Both parent and child need to know the child's shift information.
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%SHIFT_INFO_MINE(1:4),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%SHIFT_INFO_MINE stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      SHIFT_INFO_MINE=>cc%SHIFT_INFO_MINE
!
      DO N=1,4
        SHIFT_INFO_MINE(N)=-99999
      ENDDO
!
!-----------------------------------------------------------------------
!
      I_AM_A_NEST=.TRUE.
!
      IF(COMM_TO_MY_PARENT==-999)THEN                                      !<-- The uppermost parent
        I_AM_A_NEST=.FALSE.
      ENDIF
!
!-----------------------------------------------------------------------
!***  Everyone loads the coupler export state with the flag indicating
!***  whether or not they are a nest.  Nests load the flag indicating
!***  if they move or not.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Nest Flag into the Coupler Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The Parent_Child coupler export state
                            ,name ='I-Am-A-Nest Flag'                   &  !<-- The name of the flag
                            ,value=I_AM_A_NEST                          &  !<-- The nest flag
                            ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      IF(I_AM_A_NEST)THEN
!
!-----------------------------------------------------------------------
!***  If this child moves then a variety of motion-related issues
!***  are now taken care of.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Insert Moving Nest Flag into the Coupler Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child coupler export state
                              ,name ='MY_DOMAIN_MOVES'                  &  !<-- The name of the flag
                              ,value=MY_DOMAIN_MOVES                    &  !<-- The moving nest flag
                              ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  If this is not a restarted run then initialize the value of 
!***  the nest's next move timestep to nonsense.  If this is a 
!***  restarted run then the value originated in the restart file
!***  and was obtained through the P-C coupler import state in
!***  PARENT_CHILD_COUPLER_SETUP.
!-----------------------------------------------------------------------
!
        NEXT_MOVE_TIMESTEP=>cc%NEXT_MOVE_TIMESTEP
!
        IF(.NOT.RESTART)THEN
          NEXT_MOVE_TIMESTEP=-999999
        ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init2: Insert NEST_MOVE_TIMESTEP into P-C Cpl Exp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child coupler export state
                              ,name ='NEXT_MOVE_TIMESTEP'               &  !<-- The name of the Attribute
                              ,value=NEXT_MOVE_TIMESTEP                 &  !<-- Initialized value for nest's next move timestep
                              ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        I_SHIFT_CHILD=>cc%I_SHIFT_CHILD
        J_SHIFT_CHILD=>cc%J_SHIFT_CHILD
        I_SHIFT_CHILD=-999999
        J_SHIFT_CHILD=-999999
!
        I_SW_PARENT_NEW=>cc%I_SW_PARENT_NEW
        J_SW_PARENT_NEW=>cc%J_SW_PARENT_NEW
        I_SW_PARENT_NEW=-999999
        J_SW_PARENT_NEW=-999999
!
        LAST_STEP_MOVED=>cc%LAST_STEP_MOVED
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init2: Insert I_SHIFT/J_SHIFT into P-C Cpl Exp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                              ,name ='I_SHIFT'                        &  !<-- Insert Attribute with this name
                              ,value=I_SHIFT_CHILD                    &  !<-- Motion of nest in I on its grid
                              ,rc   =RC )
!
        CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                              ,name ='J_SHIFT'                        &  !<-- Insert Attribute with this name
                              ,value=J_SHIFT_CHILD                    &  !<-- Motion of nest in J on its grid
                              ,rc   =RC )
!
        CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                              ,name ='I_SW_PARENT_NEW'                &  !<-- Insert Attribute with this name
                              ,value=I_SW_PARENT_NEW                  &  !<-- Motion of nest in I on its grid
                              ,rc   =RC )
!
        CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                              ,name ='J_SW_PARENT_NEW'                &  !<-- Insert Attribute with this name
                              ,value=J_SW_PARENT_NEW                  &  !<-- Motion of nest in J on its grid
                              ,rc   =RC )
!
        CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                              ,name ='LAST_STEP_MOVED'                &  !<-- Insert Attribute with this name
                              ,value=LAST_STEP_MOVED                  &  !<-- Motion of nest in J on its grid
                              ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        I_WANT_TO_MOVE=>cc%I_WANT_TO_MOVE
        MOVE_FLAG_SENT=>cc%MOVE_FLAG_SENT
!
        I_WANT_TO_MOVE=.FALSE.                                             !<-- Initialize the nest 'move' flag
        MOVE_FLAG_SENT=.FALSE.                                             !<-- Initialize the flag for ISending the nest move flag
!
        HANDLE_MOVE_FLAG=>cc%HANDLE_MOVE_FLAG
        HANDLE_MOVE_FLAG=MPI_REQUEST_NULL
!
!-----------------------------------------------------------------------
!***  Allocate variables for children's handling their data exchange
!***  with parents in 2-way nesting.
!-----------------------------------------------------------------------
!
        IF(NEST_MODE=='2-way')THEN
!
!-----------------------------------------------------------------------
!
          HANDLE_SEND_2WAY_SIGNAL=>cc%HANDLE_SEND_2WAY_SIGNAL
!
          HANDLE_SEND_2WAY_SIGNAL=MPI_REQUEST_NULL
!
          cc%FIRST_CALL_RECV_BC=.TRUE.
!
          cc%NTIMESTEP_CHECK=-99999
!
          cc%NCYCLE_CHILD=0
!
        ENDIF
!
      ENDIF
!
!     ALLCLEAR=.TRUE.
      ALLCLEAR_SIGNAL_PRESENT=.FALSE.
      STOP_MY_MOTION=.FALSE.
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init2: Insert Initial ALLCLEAR Flag"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The Parent_Child coupler export state
                            ,name ='ALLCLEAR'                           &  !<-- The name of the flag
                            ,value=ALLCLEAR_SIGNAL_PRESENT              &  !<-- The moving nest flag
                            ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Now take care of several issues related to moving nests.
!***  All moving nests and their parents must participate.
!-----------------------------------------------------------------------
!
      parents_and_moving: IF(NUM_MOVING_CHILDREN>0                      &  !<-- This is a parent of moving nests.
                                    .OR.                                &  !
                             MY_DOMAIN_MOVES)THEN                          !<-- This is a moving nest.
!
!-----------------------------------------------------------------------
!***  Extract the Bundle with the 2-D and 3-D arrays of Solver 
!***  internal state variables needed for updating any nests that
!***  are moving.  Since the eventual update of moving nest data
!***  will be done via looping through the Fields in the Bundles
!***  we need to know how many Fields there are.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Bundles for Updates of Moving Nests in P-C Init"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateGet(state      =IMP_STATE                        &  !<-- The Parent-Child coupler import state
                          ,itemname   ='Move_Bundle H'                  &  !<-- Name of Bundle of internal state arrays to update
                          ,fieldbundle=MOVE_BUNDLE_H                    &  !<-- The H-point ESMF Bundle 
                          ,rc         =RC)
!
        CALL ESMF_StateGet(state      =IMP_STATE                        &  !<-- The Parent-Child coupler import state
                          ,itemname   ='Move_Bundle V'                  &  !<-- Name of Bundle of internal state arrays to update
                          ,fieldbundle=MOVE_BUNDLE_V                    &  !<-- The V-point ESMF Bundle 
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="How many Fields in the H Bundle?"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=MOVE_BUNDLE_H              &  !<-- The ESMF Bundle of H update arrays for moving nests
                                ,fieldcount =NUM_FIELDS_MOVE            &  !<-- # of Fields in the Bundle
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Count the number of 2-D and 3-D Fields.  Those numbers will be
!***  needed to know how many points are updated on moving nest tasks.
!***  Also initialize the flag telling parent domains they must
!***  update halos of motion-related variables after they shift.
!-----------------------------------------------------------------------
!
        NUM_FIELDS_MOVE_2D_H_I=0
        NUM_FIELDS_MOVE_2D_X_I=0
        NUM_FIELDS_MOVE_2D_H_R=0
        NUM_FIELDS_MOVE_2D_X_R=0
        NUM_FIELDS_MOVE_3D_H=0
        NUM_LEVELS_MOVE_3D_H=0
!
!-----------------------------------------------------------------------
!
        DO N_FIELD=1,NUM_FIELDS_MOVE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Fields from H Move Bundle for Counting"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldBundleGet(FIELDBUNDLE=MOVE_BUNDLE_H            &  !<-- Bundle holding the H arrays for move updates
                                  ,fieldIndex =N_FIELD                  &  !<-- Index of the Field in the Bundle
                                  ,field      =HOLD_FIELD               &  !<-- Field N_FIELD in the Bundle
                                  ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="How Many Dims in H Move Bundle Field?"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field   =HOLD_FIELD                        &  !<-- Field N_FIELD in the Bundle
                            ,dimCount=NUM_DIMS                          &  !<-- Is this Field 2-D or 3-D?
                            ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract UPDATE_TYPE from Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(field=HOLD_FIELD                       &  !<-- Get Attribute from this Field
                                ,name ='UPDATE_TYPE'                    &  !<-- Name of the attribute to extract
                                ,value=UPDATE_TYPE_INT                  &  !<-- Value of the Attribute
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(UPDATE_TYPE_INT==1)THEN
            UPDATE_TYPE_CHAR='H'                                           !<-- Ordinary H-pt variable
          ELSEIF(UPDATE_TYPE_INT==2)THEN
            UPDATE_TYPE_CHAR='L'                                           !<-- H-pt land sfc variable
          ELSEIF(UPDATE_TYPE_INT==3)THEN
            UPDATE_TYPE_CHAR='S'                                           !<-- H-pt sea sfc variable
          ELSEIF(UPDATE_TYPE_INT==4)THEN
            UPDATE_TYPE_CHAR='F'                                           !<-- H-pt variable updated from external file
          ELSEIF(UPDATE_TYPE_INT==5)THEN
            UPDATE_TYPE_CHAR='V'                                           !<-- Ordinary V-pt variable
          ENDIF
!
!-----------------------------------------------------------------------
!
          IF(NUM_DIMS==2)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Does the Field Contain Integer or Real Data?"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field   =HOLD_FIELD                      &  !<-- Field N_FIELD in the Bundle
                              ,typekind=DATATYPE                        &  !<-- Is the data Integer or Real?
                              ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            IF(DATATYPE==ESMF_TYPEKIND_I4)THEN
              NUM_FIELDS_MOVE_2D_H_I=NUM_FIELDS_MOVE_2D_H_I+1              !<-- Count ALL 2-D Integer Fields
              IF(UPDATE_TYPE_CHAR=='F')THEN
                NUM_FIELDS_MOVE_2D_X_I=NUM_FIELDS_MOVE_2D_X_I+1            !<-- Count the 2-D Integer variables updated from external files
              ENDIF
!
            ELSE
              NUM_FIELDS_MOVE_2D_H_R=NUM_FIELDS_MOVE_2D_H_R+1              !<-- Count ALL 2-D Real Fields
              IF(UPDATE_TYPE_CHAR=='F')THEN
                NUM_FIELDS_MOVE_2D_X_R=NUM_FIELDS_MOVE_2D_X_R+1            !<-- Count the 2-D Real variables updated from external files
              ENDIF
!
            ENDIF
!
!-----------------------------------------------------------------------
!
          ELSEIF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Extract 3rd Dimension Limits in 3-D H Field"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field      =HOLD_FIELD                   &  !<-- Field N in the Bundle
                              ,localDe    =0                            &
                              ,farrayPtr  =DUMMY_3D                     &  !<-- Dummy 3-D array with Field's data
                              ,totalLBound=LIMITS_LO                    &  !<-- Starting index in each dimension
                              ,totalUBound=LIMITS_HI                    &  !<-- Ending index in each dimension
                              ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            NUM_FIELDS_MOVE_3D_H=NUM_FIELDS_MOVE_3D_H+1                    !<-- Count the 3-D Real H Fields
!
            NUM_LEVELS_MOVE_3D_H=LIMITS_HI(3)-LIMITS_LO(3)+1            &  !<-- Count the # of 2-D levels in the 3-D H Fields
                                +NUM_LEVELS_MOVE_3D_H
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="How many Fields in the V Bundle?"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldBundleGet(FIELDBUNDLE=MOVE_BUNDLE_V            &  !<-- The ESMF Bundle of V update arrays for moving nests
                                  ,fieldcount =NUM_FIELDS_MOVE          &  !<-- # of Fields in the Bundle
                                  ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Count the number of 2-D and 3-D Fields.  Those numbers will be
!***  needed to know how many points are updated on moving nest tasks.
!-----------------------------------------------------------------------
!
        NUM_FIELDS_MOVE_2D_V=0
        NUM_FIELDS_MOVE_3D_V=0
        NUM_LEVELS_MOVE_3D_V=0
!
        DO N_FIELD=1,NUM_FIELDS_MOVE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Fields from V Move Bundle for Counting"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldBundleGet(FIELDBUNDLE=MOVE_BUNDLE_V            &  !<-- Bundle holding the H arrays for move updates
                                  ,fieldIndex =N_FIELD                  &  !<-- Index of the Field in the Bundle
                                  ,field      =HOLD_FIELD               &  !<-- Field N_FIELD in the Bundle
                                  ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="How Many Dims in V Move Bundle Field?"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field   =HOLD_FIELD                        &  !<-- Field N_FIELD in the Bundle
                            ,dimCount=NUM_DIMS                          &  !<-- Is this Field 2-D or 3-D?
                            ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(NUM_DIMS==2)THEN
            NUM_FIELDS_MOVE_2D_V=NUM_FIELDS_MOVE_2D_V+1
!
          ELSEIF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Extract 3rd Dimension Limits in 3-D V Field"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field      =HOLD_FIELD                   &  !<-- Field N in the Bundle
                              ,localDe    =0                            &
                              ,farrayPtr  =DUMMY_3D                     &  !<-- Dummy 3-D array with Field's data
                              ,totalLBound=LIMITS_LO                    &  !<-- Starting index in each dimension
                              ,totalUBound=LIMITS_HI                    &  !<-- Ending index in each dimension
                              ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            NUM_FIELDS_MOVE_3D_V=NUM_FIELDS_MOVE_3D_V+1                    !<-- Count the 3-D V Fields
!
            NUM_LEVELS_MOVE_3D_V=LIMITS_HI(3)-LIMITS_LO(3)+1            &  !<-- Count the # of 2-D levels in the 3-D V Fields
                                +NUM_LEVELS_MOVE_3D_V
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  The moving nests and their parents read in the four configure
!***  variables specifying the number of boundary rows on the nests'
!***  pre-move footprints whose locations will receive update data
!***  from the parent after the nests move.  All moving nests use
!***  the same values and the parent checks to be sure this is true.
!-----------------------------------------------------------------------
!
        parents_with_movers: IF(NUM_MOVING_CHILDREN>0)THEN                  !<-- Parents read moving nests' configure files
!
!-----------------------------------------------------------------------
!
          DO N=1,NUM_MOVING_CHILDREN
            NN=RANK_MOVING_CHILD(N)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="P-C Init2: Parent Reads NROWS_P_UPD_W"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_ConfigGetAttribute(config=CF(N)                   &  !<-- The child's config object
                                        ,value =NROWS_P_UPD_X           &  !<-- # of footprint W bndry rows updated by parent
                                        ,label ='nrows_p_upd_w:'        &  !<-- The configure label
                                        ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            IF(N==1)THEN
              NROWS_P_UPD_W=NROWS_P_UPD_X
            ELSE
              IF(NROWS_P_UPD_X/=NROWS_P_UPD_W)THEN
                WRITE(0,*)' Moving nests must have same values for NROWS_P_UPD_W!'
                WRITE(0,*)' Aborting!'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
              ENDIF
            ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="P-C Init2: Parent Reads NROWS_P_UPD_E"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_ConfigGetAttribute(config=CF(N)                   &  !<-- The child's config object
                                        ,value =NROWS_P_UPD_X           &  !<-- # of footprint E bndry rows updated by parent
                                        ,label ='nrows_p_upd_e:'        &  !<-- The configure label
                                        ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            IF(N==1)THEN
              NROWS_P_UPD_E=NROWS_P_UPD_X
            ELSE
              IF(NROWS_P_UPD_X/=NROWS_P_UPD_E)THEN
                WRITE(0,*)' Moving nests must have same values for NROWS_P_UPD_E!'
                WRITE(0,*)' Aborting!'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
              ENDIF
            ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="P-C Init2: Parent Reads NROWS_P_UPD_S"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_ConfigGetAttribute(config=CF(N)                   &  !<-- The child's config object
                                        ,value =NROWS_P_UPD_X           &  !<-- # of footprint S bndry rows updated by parent
                                        ,label ='nrows_p_upd_s:'        &  !<-- The configure label
                                        ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            IF(N==1)THEN
              NROWS_P_UPD_S=NROWS_P_UPD_X
            ELSE
              IF(NROWS_P_UPD_X/=NROWS_P_UPD_S)THEN
                WRITE(0,*)' Moving nests must have same values for NROWS_P_UPD_S!'
                WRITE(0,*)' Aborting!'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
              ENDIF
            ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="P-C Init2: Parent Reads NROWS_P_UPD_N"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_ConfigGetAttribute(config=CF(N)                   &  !<-- The child's config object
                                        ,value =NROWS_P_UPD_X           &  !<-- # of footprint N bndry rows updated by parent
                                        ,label ='nrows_p_upd_n:'        &  !<-- The configure label
                                        ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            IF(N==1)THEN
              NROWS_P_UPD_N=NROWS_P_UPD_X
            ELSE
              IF(NROWS_P_UPD_X/=NROWS_P_UPD_N)THEN
                WRITE(0,*)' Moving nests must have same values for NROWS_P_UPD_N!'
                WRITE(0,*)' Aborting!'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
              ENDIF
            ENDIF
!
!-----------------------------------------------------------------------
!
          ENDDO
!
!-----------------------------------------------------------------------
!***  All parents of moving nests will be reading those children's
!***  full resolution topography files that span the entire uppermost
!***  parent.  This will require these parents to know the dimensions
!***  as well as other key aspects of the uppermost parent's grid.
!***  Read the pertinent data from the uppermost parent's configure
!***  file and save what will be needed later.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Is the Upper Parent Global?"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =GLOBAL_TOP_PARENT         &  !<-- The variable filled
                                      ,label ='global:'                 &  !<-- True--> upper parent is global
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Base Dimensions of Uppermost Domain"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =IM_1                      &  !<-- The variable filled
                                      ,label ='im:'                     &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =JM_1                      &  !<-- The variable filled
                                      ,label ='jm:'                     &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Central Lat/Lon of Uppermost Domain"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =TPH0D_1                   &  !<-- The variable filled
                                      ,label ='tph0d:'                  &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =TLM0D_1                   &  !<-- The variable filled
                                      ,label ='tlm0d:'                  &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Southern/Western Boundary of Uppermost Domain"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =SBD_1                     &  !<-- The variable filled
                                      ,label ='sbd:'                    &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
          CALL ESMF_ConfigGetAttribute(config=CF_1                      &  !<-- The config object of domain #1
                                      ,value =WBD_1                     &  !<-- The variable filled
                                      ,label ='wbd:'                    &  !<-- Give this label's value to the previous variable
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
          TPH0_1=TPH0D_1*D2R                                               !<-- Central geo lat of domain (radians, positive north)
          TLM0_1=TLM0D_1*D2R                                               !<-- Central geo lon of domain (radians, positive east)
          WB_1=WBD_1*D2R                                                   !<-- Rotated lon of west boundary (radians, positive east)
          SB_1=SBD_1*D2R                                                   !<-- Rotated lat of south boundary (radians, positive north)
!
          DPH_1=-2.*SB_1/(JM_1-1)                                          !<-- Uppermost parent's grid increment in J (radians)
          DLM_1=-2.*WB_1/(IM_1-1)                                          !<-- Uppermost parent's grid increment in I (radians)
!
          RECIP_DPH_1=1./DPH_1
          RECIP_DLM_1=1./DLM_1
!
!-----------------------------------------------------------------------
!
        ENDIF parents_with_movers
!
!-----------------------------------------------------------------------
!
        IF(MY_DOMAIN_MOVES)THEN                                            !<-- Moving nests read their configure files
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Init2: Extract NTRACK flag from P-C Cpl import state."                         
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state=IMP_STATE                        &  !<-- The Parent-Child coupler import state.
                                ,name ='NTRACK'                         &  !<-- Name of the attribute to extract
                                ,value=NTRACK                           &  !<-- Total # of levels in all Real 2-way exch variables
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Nest Reads NROWS_P_UPD_W"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =NROWS_P_UPD_W             &  !<-- # of footprint W bndry rows updated by parent
                                      ,label ='nrows_p_upd_w:'          &  !<-- The configure label
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Nest Reads NROWS_P_UPD_E"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =NROWS_P_UPD_E             &  !<-- # of footprint E bndry rows updated by parent
                                      ,label ='nrows_p_upd_e:'          &  !<-- The configure label
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Nest Reads NROWS_P_UPD_S"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =NROWS_P_UPD_S             &  !<-- # of footprint S bndry rows updated by parent
                                      ,label ='nrows_p_upd_s:'          &  !<-- The configure label
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Nest Reads NROWS_P_UPD_N"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =NROWS_P_UPD_N             &  !<-- # of footprint N bndry rows updated by parent
                                      ,label ='nrows_p_upd_n:'          &  !<-- The configure label
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  What is the distance between this moving nest's center
!***  and its moving child's before this nest will consider 
!***  shifting in order to follow its child?  The value is only
!***  relevant for a moving nest with a child.  Units are grid
!***  increments on this moving nest's grid.
!-----------------------------------------------------------------------
!
          CENTERS_DISTANCE=R4_IN                                           !<-- Initialize to nonsense
!
          IF(NUM_CHILDREN>0.AND.MY_DOMAIN_MOVES)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Outer nest reads centers separation"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_ConfigGetAttribute(config=CF_MINE                 &  !<-- The nest's config object
                                        ,value =CENTERS_DISTANCE        &  !<-- Distance between outer/inner nest centers before outer shift
                                        ,label ='centers_distance:'     &  !<-- The configure label
                                        ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  What is the latitude (degrees) past which no nests will be 
!***  allowed to move?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="P-C Init2: Nest Reads Latitude Limit"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF_MINE                   &  !<-- The nest's config object
                                      ,value =LATITUDE_LIMIT            &  !<-- Max distance nest bndry can move from equator (deg)
                                      ,label ='latitude_limit:'         &  !<-- The configure label
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          NORTH_LAT_MAX_MVG_NEST=LATITUDE_LIMIT*D2R                        !<-- Mvg nest Nbndry must not pass this latitude (rad)
          SOUTH_LAT_MAX_MVG_NEST=-NORTH_LAT_MAX_MVG_NEST                   !<-- Mvg nest Sbndry must not pass this latitude (rad)
!
!-----------------------------------------------------------------------
!***  Moving nests set up some variables for computing motion.
!-----------------------------------------------------------------------
!
          FIRST_PASS_M=.TRUE.
!
          ALLOCATE(cc%I_PG(1:4))
          ALLOCATE(cc%J_PG(1:4))
!
          ALLOCATE(cc%I_HOLD_PG_POINT(1:4))
!
          I_CENTER_CURRENT=IDS+INT(0.5*(IDE-IDS)+EPS)
          J_CENTER_CURRENT=JDS+INT(0.5*(JDE-JDS)+EPS)
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF parents_and_moving
!
!-----------------------------------------------------------------------
!***  Additional setup for parents of moving nests and/or for moving
!***  parents with any children at all.
!-----------------------------------------------------------------------
!
      nests_move: IF(NUM_MOVING_CHILDREN>0)THEN
!
!-----------------------------------------------------------------------
!***  By 'moving nest' we mean any domain that moves across the earth
!***  and not those domains that move within their parent's domain.
!***  This would therefore include static children inside moving parents
!***  however that arrangement is not allowed at present.  That setup
!***  would require full updates of the child domain following the
!***  parent's shift since the child moved with resepct to the earth
!***  and atmosphere.  However a moving child in a moving parent will
!***  stay in place when its parent shifts and thus that child domain
!***  needs no updating at all following the parent shift.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Parents with moving nests need to know those nests' topography
!***  at the nests' own resolutions for the hydrostatic adjustment
!***  that must take place when the parents interpolate their data
!***  to moving nest grid points.  For the sake of generality all
!***  of those nest-resolution datasets must span the domain of the
!***  uppermost parent which is the true maximum range of any nest's
!***  motion.
!
!***  So each parent with moving nests must:
!***   (1) Know how many different space resolutions its moving 
!***       children use;
!***   (2) Associate each resolution with the appropriate moving
!***       child using the nest-to-uppermost parent space ratio
!***       that the user specified in each moving nest's configure 
!***       file;
!***   (3) Have each of its forecast tasks read in its own piece of
!***       each different resolution of topography data needed by
!***       all of its moving children.
!
!***  If a parent domain moves then it must refill its task subdomains
!***  with the topography of its moving children each time it (the
!***  parent) shifts its position.  That is handled in subroutine
!***  CHILDREN_RECV_PARENT_DATA.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%M_NEST_RATIO(1:NUM_MOVING_CHILDREN),stat=ISTAT)        !<-- Associate moving nests with list of different space ratios
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%M_NEST_RATIO stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        M_NEST_RATIO=>cc%M_NEST_RATIO
!
        ALLOCATE(cc%LIST_OF_RATIOS(1:NUM_MOVING_CHILDREN),stat=ISTAT)      !<-- Keep a list of the different space ratios
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%LIST_OF_RATIOS stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        LIST_OF_RATIOS=>cc%LIST_OF_RATIOS
!
        ALLOCATE(cc%LINK_MRANK_RATIO(1:NUM_MOVING_CHILDREN),stat=ISTAT)    !<-- Which different space ratio for each moving child
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%LINK_MRANK_RATIO stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        LINK_MRANK_RATIO=>cc%LINK_MRANK_RATIO
!
        NN=0
        NUM_SPACE_RATIOS_MVG=0                                             !<-- Count the different resolutions of moving children
!
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
!
          IF(STATIC_OR_MOVING(N)=='Static')CYCLE
          NN=NN+1
!
!-----------------------------------------------------------------------
!
          LIST_OF_RATIOS(NN)=0         
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Moving Child's Sfc File Ratio"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_ConfigGetAttribute(config=CF(N)                     &  !<-- Child N's config object
                                      ,value =SFC_FILE_RATIO            &  !<-- Save the configure value with the following label.
                                      ,label ='ratio_sfc_files:'        &  !<-- Ratio of upper parent's grid increment to this nest's
                                      ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!  
          M_NEST_RATIO(NN)=SFC_FILE_RATIO                                  !<-- Moving child NN uses topography file with this ratio/ID
!
          IF(NN==1)THEN
            NUM_SPACE_RATIOS_MVG=1                                         !<-- Begin counting the space ratios of moving children
            LIST_OF_RATIOS(1)=SFC_FILE_RATIO                               !<-- The 1st sfc file ratio is that of the 1st moving nest
            LINK_MRANK_RATIO(1)=1                                          !<-- 1st moving nest uses 1st sfc file ratio
!
          ELSE
            FOUND=.FALSE.                                                  
            DO KR=1,NUM_SPACE_RATIOS_MVG
              IF(SFC_FILE_RATIO==LIST_OF_RATIOS(KR))THEN
                FOUND=.TRUE.
                LINK_MRANK_RATIO(NN)=KR                                    !<-- Moving nest NN uses existing KR'th sfc file ratio 
                EXIT
              ENDIF
            ENDDO
!
            IF(.NOT.FOUND)THEN
              NUM_SPACE_RATIOS_MVG=NUM_SPACE_RATIOS_MVG+1                  !<-- Increment the counter of children's different space ratios
              LIST_OF_RATIOS(NUM_SPACE_RATIOS_MVG)=SFC_FILE_RATIO          !<-- Save the new ratio in the list of different ratios
              LINK_MRANK_RATIO(NN)=NUM_SPACE_RATIOS_MVG                    !<-- Moving child NN uses this rank in list of all different ratios
            ENDIF
!
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%NEST_FIS_ON_PARENT(1:NUM_SPACE_RATIOS_MVG),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%NEST_FIS_ON_PARENT stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        NEST_FIS_ON_PARENT=>cc%NEST_FIS_ON_PARENT
!
        ALLOCATE(cc%NEST_FIS_V_ON_PARENT(1:NUM_SPACE_RATIOS_MVG),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%NEST_FIS_V_ON_PARENT stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        NEST_FIS_V_ON_PARENT=>cc%NEST_FIS_V_ON_PARENT
!
        DO N=1,NUM_SPACE_RATIOS_MVG
          NEST_FIS_ON_PARENT(N)%DATA=>NULL()
          NEST_FIS_V_ON_PARENT(N)%DATA=>NULL()
        ENDDO
!
        ALLOCATE(cc%NEST_FIS_ON_PARENT_BNDS(1:NUM_SPACE_RATIOS_MVG),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%NEST_FIS_ON_PARENT_BNDS stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        NEST_FIS_ON_PARENT_BNDS=>cc%NEST_FIS_ON_PARENT_BNDS
!
!-----------------------------------------------------------------------
!***  Now fill the parent's data objects that hold the nest-resolution
!***  topography at child H points and child V points.
!-----------------------------------------------------------------------
!
        CALL PARENT_READS_MOVING_CHILD_TOPO(MY_DOMAIN_ID                &
                                           ,NUM_MOVING_CHILDREN         &
                                           ,LINK_MRANK_RATIO            &
                                           ,LIST_OF_RATIOS              &
                                           ,M_NEST_RATIO                &
                                           ,NUM_SPACE_RATIOS_MVG        &
                                           ,GLOBAL_TOP_PARENT           &
                                           ,IM_1,JM_1                   &
                                           ,TPH0_1,TLM0_1               &
                                           ,SB_1,WB_1                   &
                                           ,RECIP_DPH_1,RECIP_DLM_1     &
                                           ,GLAT,GLON                   &
                                           ,NEST_FIS_ON_PARENT_BNDS     &
                                           ,NEST_FIS_ON_PARENT          &
                                           ,NEST_FIS_V_ON_PARENT        &
                                           ,IDS,IDE,IMS,IME,ITS,ITE     &
                                           ,JDS,JDE,JMS,JME,JTS,JTE)
!
!-----------------------------------------------------------------------
!
      ENDIF nests_move
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Extract the 2-way Bundle holding pointers to Solver internal 
!***  state variables needed for 2-way exchange of data between 
!***  children and parents.  Since the generation and incorporation
!***  of 2-way exchange data will be done via looping through Fields
!***  we need to know how many Fields there are.
!-----------------------------------------------------------------------
!
      IF(I_AM_A_FCST_TASK.AND.NEST_MODE=='2-way')THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract 2-way Bundle in P-C Init"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateGet(state      =IMP_STATE                        &  !<-- The Parent-Child coupler import state
                          ,itemname   ='Bundle_2way'                    &  !<-- Name of 2-way Bundle of internal state arrays to use
                          ,fieldbundle=BUNDLE_2WAY                      &  !<-- The ESMF 2-way Bundle 
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="How many Fields in the 2-way Bundle?"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_2WAY                &  !<-- The ESMF Bundle of 2-way exchange variables
                                ,fieldcount =NVARS_2WAY_UPDATE          &  !<-- # of Fields in the Bundle
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract # of levels in all fields in 2-way Bundle"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(FIELDBUNDLE=BUNDLE_2WAY                  &  !<-- The ESMF Bundle of 2-way exchange variables
                              ,name ='NLEV 2-way'                       &  !<-- Name of the attribute to extract
                              ,value=NLEV_2WAY                          &  !<-- Total # of levels in all Real 2-way exch variables
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Compute the number of timesteps between restart outputs.
!***  This will be used if the domain is a moving nest.  The nest
!***  will not be allowed to decide to move LAG_STEPS parent
!***  timesteps before a restart output time.  This will postpone
!***  such decisions until after the restart output time and thus
!***  ensure that the same decision will be made in the forecast
!***  when it is restarted.
!***  This variable is also used in a similar way in 2-way nesting.
!***  Children send 2-way exchange data to their parents at the end
!***  of parent timestep N and the parents receive it early in 
!***  parent timestep N+1.  For bit-reproducible restarts we must
!***  therefore not let parents incorporate 2-way data in parent
!***  timesteps that immediately follow the writing of a restart file.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Init2: Nest Reads NROWS_P_UPD_N"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF_MINE                       &  !<-- The nest's config object
                                  ,value =MINUTES_RESTART               &  !<-- Minutes between restart output
                                  ,label ='minutes_restart:'            &  !<-- The configure label
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      cc%NTIMESTEPS_RESTART=NINT((60.*MINUTES_RESTART)/DT_DOMAIN(MY_DOMAIN_ID))
!
!-----------------------------------------------------------------------
!
      IF(ASSOCIATED(DOMAIN_ID_TO_RANK))DEALLOCATE(DOMAIN_ID_TO_RANK)
!
!-----------------------------------------------------------------------
!
!------------
!***  Timers
!------------
!
      cpl1_prelim_tim=>cc%cpl1_prelim_tim
      cpl1_south_h_tim=>cc%cpl1_south_h_tim
      cpl1_south_v_tim=>cc%cpl1_south_v_tim
      cpl1_north_h_tim=>cc%cpl1_north_h_tim
      cpl1_north_v_tim=>cc%cpl1_north_v_tim
      cpl1_west_h_tim=>cc%cpl1_west_h_tim
      cpl1_west_v_tim=>cc%cpl1_west_v_tim
      cpl1_east_h_tim=>cc%cpl1_east_h_tim
      cpl1_east_v_tim=>cc%cpl1_east_v_tim
      cpl1_recv_tim=>cc%cpl1_recv_tim
!
      cpl1_recv_tim=>cc%cpl1_recv_tim
!
      cpl1_south_h_recv_tim=>cc%cpl1_south_h_recv_tim
      cpl1_south_h_undo_tim=>cc%cpl1_south_h_undo_tim
      cpl1_south_h_exp_tim=>cc%cpl1_south_h_exp_tim
      cpl1_south_v_recv_tim=>cc%cpl1_south_v_recv_tim
      cpl1_south_v_undo_tim=>cc%cpl1_south_v_undo_tim
      cpl1_south_v_exp_tim=>cc%cpl1_south_v_exp_tim
!
      cpl2_comp_tim=>cc%cpl2_comp_tim
      cpl2_wait_tim=>cc%cpl2_wait_tim
      cpl2_send_tim=>cc%cpl2_send_tim
!
      moving_nest_bookkeep_tim=>cc%moving_nest_bookkeep_tim
      moving_nest_update_tim=>cc%moving_nest_update_tim
      parent_bookkeep_moving_tim=>cc%parent_bookkeep_moving_tim
      parent_update_moving_tim=>cc%parent_update_moving_tim
      t0_recv_move_tim=>cc%t0_recv_move_tim
      read_moving_child_topo_tim=>cc%read_moving_child_topo_tim
      barrier_move_tim=>cc%barrier_move_tim
      pscd_tim=>cc%pscd_tim
      pscd1_tim=>cc%pscd1_tim
      pscd2_tim=>cc%pscd2_tim
      pscd3_tim=>cc%pscd3_tim
      pscd4_tim=>cc%pscd4_tim
      ja1_tim=>cc%ja1_tim
      ja2_tim=>cc%ja2_tim
      ja3_tim=>cc%ja3_tim
      ja4_tim=>cc%ja4_tim
      jat_tim=>cc%jat_tim
!
      cpl1_prelim_tim=0.
      cpl1_south_h_tim=0.
      cpl1_south_v_tim=0.
      cpl1_north_h_tim=0.
      cpl1_north_v_tim=0.
      cpl1_west_h_tim=0.
      cpl1_west_v_tim=0.
      cpl1_east_h_tim=0.
      cpl1_east_v_tim=0.
      cpl1_recv_tim=0.
!
      cpl1_south_h_recv_tim=0.
      cpl1_south_h_undo_tim=0.
      cpl1_south_h_exp_tim=0.
      cpl1_south_v_recv_tim=0.
      cpl1_south_v_undo_tim=0.
      cpl1_south_v_exp_tim=0.
!
      cpl2_comp_tim=0.
      cpl2_wait_tim=0.
      cpl2_send_tim=0.
!
      moving_nest_bookkeep_tim  =0.
      moving_nest_update_tim    =0.
      parent_bookkeep_moving_tim=0.
      parent_update_moving_tim  =0.
      t0_recv_move_tim          =0.
      read_moving_child_topo_tim=0.0
      barrier_move_tim=0.0
      pscd_tim=0.
      pscd1_tim=0.
      pscd2_tim=0.
      pscd3_tim=0.
      pscd4_tim=0.
      ja1_tim=0.
      ja2_tim=0.
      ja3_tim=0.
      ja4_tim=0.
      jat_tim=0.
!
!-----------------------------------------------------------------------
!
      IF(RC_CPL_INIT==ESMF_SUCCESS)THEN
!       WRITE(0,*)"PARENT_CHILD_CPL INITIALIZE STEP SUCCEEDED"
      ELSE
        WRITE(0,*)"PARENT_CHILD_CPL INITIALIZE STEP FAILED"
      ENDIF
!
      RC_FINAL=RC_CPL_INIT
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_CPL_INITIALIZE2
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE CHECK_2WAY_SIGNALS(CPL_COMP                            &
                                   ,IMP_STATE                           &
                                   ,EXP_STATE                           &
                                   ,CLOCK                               &
                                   ,RC_FINAL )
!
!-----------------------------------------------------------------------
!***  When 2-way nesting is used do not proceed into a timestep until
!***  the update data from all of the current domain's children have
!***  been received and the current domain's parent has signaled that
!***  the parent has received 2-way update data from all of its
!***  children.  This routine checks for those conditions.
!***  This is phase 1 of the Parent-Child coupler's Run step.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ALLCLEAR_SIGNAL_TAG,CHILDTASK_0             &
                           ,COMM_FCST_TASKS,MY_DOMAIN_ID,N,NTIMESTEP
!
      INTEGER(kind=KINT) :: IERR,RC,RC_CPL_RUN
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      LOGICAL(kind=KLOG) :: ALLCLEAR_SIGNAL_IS_PRESENT                  &
                           ,ALLCLEAR_SIGNAL                             &
                           ,READY_TO_RECV                               &
                           ,TWOWAY_SIGNAL_IS_PRESENT
!
      LOGICAL(kind=KLOG) :: RECV_ALL_CHILD_DATA
!
      integer(kind=kint) :: mype_local
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC        =ESMF_SUCCESS
      RC_FINAL  =ESMF_SUCCESS
      RC_CPL_RUN=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  What is the current timestep on this nest's Clock?
!-----------------------------------------------------------------------
!
      CALL ESMF_ClockGet(clock       =CLOCK                             &
                        ,advanceCount=NTIMESTEP_ESMF                    &  !<-- The current timestep of this domain (ESMF)
                        ,rc          =RC)
!
      NTIMESTEP=NTIMESTEP_ESMF                                             !<-- The current timestep of this domain (integer)
!
!-----------------------
!***  Current Domain ID
!-----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------------------
!***  Intracommunicator between forecast tasks
!----------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Fcst Task Intracomm in P-C Coupler Init0"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Intracommunicator for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Point to the correct part of the composite object.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Do not repeatedly extract the parent's ALLCLEAR signal if it
!***  was already done in the current timestep.
!-----------------------------------------------------------------------
!
      IF(NTIMESTEP>NTIMESTEP_CHECK)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract ALLCLEAR Signal from P-C Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE                          &  !<-- The parent-child coupler import state
                              ,name ='ALLCLEAR'                         &  !<-- Name of the attribute to extract
                              ,value=ALLCLEAR_SIGNAL_PRESENT            &  !<-- ALLCLEAR signal reset to fals
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NTIMESTEP_CHECK=NTIMESTEP
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  When 2-way nests are being used then this child checks to see
!***  if its parent has sent a signal indicating it has received all
!***  exchange data from this child and its siblings.  That signal
!***  means this child is now free to proceed in its integration.
!***  If the signal is not present then the child immediately
!***  returns and exits the current iteration of the time loop
!***  without incrementing the timestep. 
!-----------------------------------------------------------------------
!
      children: IF(MY_DOMAIN_ID>1                                       &  !<-- Select the domains with parents
                       .AND.                                            &
                   MOD(NTIMESTEP,TIME_RATIO_MY_PARENT)==0               &  !<-- Is this a timestep boundary of my parent?
                       .AND.                                            &
                   .NOT.ALLCLEAR_SIGNAL_PRESENT)THEN                       !<-- Already recvd signal from parent this timestep?
!-----------------------------------------------------------------------
!
        IF(I_AM_LEAD_FCST_TASK)THEN
          ALLCLEAR_SIGNAL_TAG=20000+1000*MY_DOMAIN_ID+10*NTIMESTEP         !<-- Use the domain ID,timestep to get a unique tag
!
          CALL MPI_IPROBE(0                                             &  !<-- Parent task 0 sends the signal
                         ,ALLCLEAR_SIGNAL_TAG                           &  !<-- The message's tag
                         ,COMM_TO_MY_PARENT                             &  !<-- Communicator to the parent
                         ,ALLCLEAR_SIGNAL_IS_PRESENT                    &  !<-- Has the parent's signal arrived?
                         ,JSTAT                                         &  !<-- MPI status object
                         ,IERR )
!
          IF(ALLCLEAR_SIGNAL_IS_PRESENT)THEN
            CALL MPI_RECV(ALLCLEAR_SIGNAL                               &  !<-- Clear the buffer if signal is present
                         ,1                                             &  !<-- Signal has 1 word
                         ,MPI_LOGICAL                                   &  !<-- Signal is logical
                         ,0                                             &  !<-- Signal sent by parent task 0
                         ,ALLCLEAR_SIGNAL_TAG                           &  !<-- Tag associated with the signal
                         ,COMM_TO_MY_PARENT                             &  !<-- Communicator between child and parent
                         ,JSTAT                                         &  !<-- MPI status object
                         ,IERR )
!
          ENDIF
!
        ENDIF
!
        btim=timef()
        CALL MPI_BCAST(ALLCLEAR_SIGNAL_IS_PRESENT                       &  !<-- Can the child tasks proceed or not?
                      ,1                                                &  !<-- The signal is one word
                      ,MPI_LOGICAL                                      &  !<-- The signal is logical
                      ,0                                                &  !<-- Broadcast from lead nest forecast task
                      ,COMM_FCST_TASKS                                  &  !<-- MPI communicator for this nest's forecast tasks
                      ,IERR)
        cbcst_tim(my_domain_id)=cbcst_tim(my_domain_id)+(timef()-btim)
!
        ALLCLEAR_SIGNAL_PRESENT=ALLCLEAR_SIGNAL_IS_PRESENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="NMM_INTEGRATE: Child Inserts ALLCLEAR into Cpl Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent-Child coupler export state
                              ,name ='ALLCLEAR'                         &  !<-- Name of the attribute to insert
                              ,value=ALLCLEAR_SIGNAL_PRESENT            &  !<-- Parent does/not have exch data; child can/not proceed
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      ENDIF children
!
!-----------------------------------------------------------------------
!***  Also with 2-way nesting this parent checks to see if all its
!***  children have indicated they are ready to send their 2-way
!***  update data.  If not then the parent immediately returns and
!***  exits the current iteration of the time loop without incrementing
!***  the timestep.
!
!***  When any of this parent's children catch up to the parent at
!***  the end of a parent timestep then that child's lead fcst task
!***  sends a signal to the parent's lead fcst task that the child
!***  is ready to send the 2-way exchange data.  Here the parent lead
!***  fcst task probes for that signal from each of the children.  The
!***  probe needs to be done until all children have been heard from.
!-----------------------------------------------------------------------
!
      parents: IF(NUM_CHILDREN>0)THEN                                      !<-- Select the domains with children
!
!-----------------------------------------------------------------------
!
!       call mpi_comm_rank(comm_fcst_tasks,mype_local,ierr)    
        READY_TO_RECV=.FALSE.
!
        task0_a: IF(I_AM_LEAD_FCST_TASK)THEN
!
          IF(KOUNT_2WAY_CHILDREN<NUM_2WAY_CHILDREN)THEN
!
            DO N=1,NUM_CHILDREN
!
              CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(0)      !<-- Local rank of child's lead task in p-c communicator
              TWOWAY_SIGNAL_TAG=1115+1000*MY_CHILDREN_ID(N)               &  !<-- Use child's domain ID,timestep to create a unique tag
                                +10*(NTIMESTEP*TIME_RATIO_MY_CHILDREN(N)-1)
!
              CALL MPI_IPROBE(CHILDTASK_0                               &  !<-- Is 2-way signal present from child N's fcst task 0?
                             ,TWOWAY_SIGNAL_TAG                         &  !<-- Tag associated with 2way signal from children
                             ,COMM_TO_MY_CHILDREN(N)                    &  !<-- MPI communicator between parent and child N
                             ,TWOWAY_SIGNAL_IS_PRESENT                  &  !<-- Has the child's 2-way exchange signal arrived?
                             ,JSTAT                                     &
                             ,IERR)
!
              IF(TWOWAY_SIGNAL_IS_PRESENT)THEN
!
                CALL MPI_RECV(SIGNAL_2WAY_SEND_READY(N)                 &  !<-- Recv the signal and clear this child's ISend
                             ,1                                         &  !<-- # of words in signal
                             ,MPI_LOGICAL                               &  !<-- The signal is type Logical
                             ,CHILDTASK_0                               &  !<-- The signal was sent by child N's fcst task 0.
                             ,TWOWAY_SIGNAL_TAG                         &  !<-- Tag associated with 2way signal from children
                             ,COMM_TO_MY_CHILDREN(N)                    &  !<-- MPI communicator between parent and moving child N
                             ,JSTAT                                     &
                             ,IERR)
!
                KOUNT_2WAY_CHILDREN=KOUNT_2WAY_CHILDREN+1                  !<-- Keep track of how many children have sent data
!
              ENDIF
!
            ENDDO
!
          ENDIF
!
          IF(KOUNT_2WAY_CHILDREN==NUM_2WAY_CHILDREN)THEN
            READY_TO_RECV=.TRUE.
          ENDIF
!
        ENDIF task0_a
!
!-----------------------------------------------------------------------
!***  The parent's lead forecast task informs the rest of the parent
!***  forecast tasks whether or not all the children have indicated
!***  they have sent their 2-way exchange data.  If they have not
!***  then the parent tasks cannot integrate in this pass through
!***  the generations loop and they set a flag to that effect.  If
!***  all children have sent their data then the appropriate parent
!***  tasks receive and incorporate that data then all parent tasks
!***  set a flag freeing them to integrate in this iteration of the
!***  generations loop in NMM_RUN, i.e., to call phase 1 of the
!***  Run step of the Domain component in NMM_INTEGRATE.
!-----------------------------------------------------------------------
!
        btim=timef()
        CALL MPI_BCAST(READY_TO_RECV                                    &  !<-- Is children's exchange data ready to be recvd?
                      ,1                                                &  !<-- # of words in the flag
                      ,MPI_LOGICAL                                      &  !<-- The flag is logical
                      ,0                                                &  !<-- Data sent from parent task 0
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for this domain's fcst tasks
                      ,IERR )
        pbcst_tim(my_domain_id) = pbcst_tim(my_domain_id) + (timef()-btim)
!
        CALL MPI_BARRIER(COMM_FCST_TASKS,IERR)                             !<-- Syncs Probe below with BC ISends above; required
!
!-----------------------------------------------------------------------
!
        IF(READY_TO_RECV)THEN
!
          RECV_ALL_CHILD_DATA=.TRUE.
!         if(i_am_lead_fcst_task)then
!           if(ncycle_parent>3)then
!           write(0,24331)ncycle_parent,my_domain_id,ntimestep
24331       format(' parent cycled ',i5,' times  my_domain_id=',i2,' ntimestep=',i6)
!           endif
!           ncycle_parent=0
!         endif
!
        ELSE
!
          RECV_ALL_CHILD_DATA=.FALSE.
!         ncycle_parent=ncycle_parent+1
!
        ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="PARENTS_RECV_CHILD_2WAY_DATA: Set Integrate Flag"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The P-C coupler's export state
                              ,name ='Recv All Child Data'              &
                              ,value=RECV_ALL_CHILD_DATA                &
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      ENDIF parents
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHECK_2WAY_SIGNALS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE CHILDREN_RECV_PARENT_DATA(CPL_COMP                     &
                                          ,IMP_STATE                    &
                                          ,EXP_STATE                    &
                                          ,CLOCK                        &
                                          ,RC_FINAL)
!
!-----------------------------------------------------------------------
!***  Run the coupler step where children receive data from parents.
!***  This is phase 2 of the coupler Run step and it occurs at the 
!***  beginning of the timesteps.  The parents send the data in 
!***  phase 4 at the end of the timesteps.  Only child tasks enter
!***  this routine.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: NEXT_MOVE_TIMESTEP_PARENT
!
      INTEGER(kind=KINT) :: ALLCLEAR_SIGNAL_TAG                         &
                           ,BC_UPDATE_FLAG,CHILDTASK_0                  &
                           ,COMM_FCST_TASKS                             &
                           ,ID_GRANDPARENT                              &
                           ,I_DIFF,J_DIFF                               &
                           ,MAX_SHIFT_CHILD                             &
                           ,MY_DOMAIN_ID,MYPE_LOCAL                     &
                           ,N,NN,NTIMESTEP,NTAG0
!
      INTEGER(kind=KINT) :: I_SHIFT,I_SHIFT_MY_GRID,I_SHIFT_PARENT_GRID &
                           ,J_SHIFT,J_SHIFT_MY_GRID,J_SHIFT_PARENT_GRID
!
      INTEGER(kind=KINT) :: IERR,IRTN,RC,RC_CPL_RUN
!
!xxx  INTEGER(kind=KINT),DIMENSION(2) :: STORM_CENTER
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      REAL(kind=KFPT) :: CHILD_DOMAIN_EW,CHILD_DOMAIN_NS                &
                        ,DIFF_I,DIFF_J                                  &
                        ,DT_GRANDPARENT,PARENT_DIFF,SHIFT_LAT
!
      REAL(kind=KFPT) :: CENTER_I_INNER,CENTER_I_OUTER                  &
                        ,CENTER_J_INNER,CENTER_J_OUTER
!
      REAL(kind=KFPT) :: DIST_EAST,DIST_WEST                            &
                        ,DIST_NORTH,DIST_SOUTH                          &
                        ,DIST_TO_PARENT_BNDRY                           &
                        ,DISTANCE
!
      REAL(kind=KFPT) :: DISTN_TO_PARENT_BNDRY                          &
                        ,DISTN_EAST,DISTN_WEST                          &
                        ,DISTN_NORTH,DISTN_SOUTH
!
      REAL(kind=KFPT) :: DOMAIN_NBND,DOMAIN_SBND                        &
                        ,PARENT_NBND,PARENT_SBND
!
      LOGICAL(kind=KLOG) :: ALLCLEAR_SIGNAL_IS_PRESENT                  &
                           ,ALLCLEAR_SIGNAL
!
      TYPE(COMPOSITE),POINTER :: CC
!
      TYPE(INTERIOR_DATA_FROM_PARENT),DIMENSION(1:4) :: SEND_TASK          !<-- Specifics about interior data from sending parent tasks
!
      LOGICAL(kind=KLOG) :: PARENT_SHIFT_IS_PRESENT
!
      LOGICAL(kind=KLOG) :: ALLCLEAR_SIGNAL_PRESENT                     &
                           ,MOVE_NOW
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      btim =timef()
      btim0=timef()
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC        =ESMF_SUCCESS
      RC_FINAL  =ESMF_SUCCESS
      RC_CPL_RUN=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  What is the current timestep on this nest's Clock?
!-----------------------------------------------------------------------
!
      CALL ESMF_ClockGet(clock       =CLOCK                             &
                        ,advanceCount=NTIMESTEP_ESMF                    &  !<-- The current timestep of this child (ESMF)
                        ,rc          =RC)
!
      NTIMESTEP=NTIMESTEP_ESMF                                             !<-- The current timestep of this child (integer)
!
!-----------------------
!***  Current Domain ID
!-----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Point to the correct part of the composite object.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!----------------------------------
!***  Are we in the free forecast?
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PARENTS_SEND_CHILD_DATA: Extract Free Forecast flag"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Free Forecast'                      &  !<-- Name of the attribute to extract
                            ,value=FREE_FORECAST                        &  !<-- Is this the free forecast?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      DIG_FILTER=.FALSE.
      IF(.NOT.FREE_FORECAST)THEN
        DIG_FILTER=.TRUE.
      ELSEIF(FREE_FORECAST)THEN
        I_AM_ACTIVE=.TRUE.                                                 !<-- All domains are always active in the free forecast.
      ENDIF     
!
!-----------------------------------------------------------
!***  Intracommunicator for current domain's forecast tasks
!-----------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Fcst Task Intracommunicator"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Current domain's intracomm for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL MPI_COMM_RANK(COMM_FCST_TASKS,MYPE_LOCAL,IERR)                  !<-- Local task rank in this domain's fcst tasks
!
!-----------------------------------------------------------------------
!***  The child is now at the beginning of a timestep that coincides
!***  with the beginning of a parent timestep which is where moving
!***  children execute their shifts.  To eliminate potential randomness
!***  a child will always shift a fixed number of timesteps after it
!***  has made the decision to move.  It is then at that point in 
!***  time that the parent will generate new internal data for the
!***  child as well as new starting boundary data for the child's new
!***  location.  So it is at that point in time that the child will
!***  have the data needed to execute its shift.
!-----------------------------------------------------------------------
!
      moving_children_a: IF(MY_DOMAIN_MOVES)THEN                           !<-- Select the moving nests
!        
!-----------------------------------------------------------------------
!
        MOVE_NOW=.FALSE.
!
!-----------------------------------------------------------------------
!***  If this is now the point in time at which the parent prepared
!***  internal and boundary data for the child's new position, then
!***  the child initiates its shift now by receiving the data prepared
!***  for it by its parent for the child's new position.  Note that
!***  the actual updating of the prognostic variables due to the
!***  shift takes place in DOMAIN_RUN which is called in NMM_INTEGRATE
!***  following phases 2 and 3 of the Parent-Child coupler (where the
!***  children receive update data from their parents and the parents
!***  receive update data from their children, respectively).  
!-----------------------------------------------------------------------
!
        the_child_moves: IF(NTIMESTEP==NEXT_MOVE_TIMESTEP)THEN
!
!-----------------------------------------------------------------------
!***  Later in this subroutine moving nests begin their decision of 
!***  whether they want to shift with the call to COMPUTE_STORM_MOTION.
!***  If they do want to shift then they check to see if the shift
!***  would lead to a collision with their parent's boundary.  If the
!***  nest is also a parent it checks to see if its desired shift
!***  would lead to a collision with its children.  However after
!***  the decision to shift is made then the nest must wait LAG_STEPS
!***  timesteps of its parent before executing that shift.  This is
!***  because in 1-way nesting the parent can run several timesteps
!***  ahead of its children and thus the parent will lie out in the
!***  child's future when the parent learns what the new location of
!***  the child will be.  Only then can the parent generate new data
!***  to update the child's boundaries at that location.  The existence
!***  of this time lag can permit a fatal situation.  A child/parent
!***  may determine it is safe to shift given the current location
!***  of the domains involved but then before it executes the shift
!***  the related parent/child may decide it also wants to shift and 
!***  determines it is safe to shift given the present location of the
!***  of the domains.  After the first of the domains shifts that may
!***  then make the shift of the second domain fatal by leading to
!***  a collision IF either or both shifts are relatively large.
!
!***  Here are the three basic scenarios that must be avoided.
!
!-----------------------------------------------------------------------
!                         Scenario 1
!-----------------------------------------------------------------------
!
!                   <------  Child decides it wants to shift
!
!              <-------  Parent decides it wants to shift
!  TIME
!   |               <------  Child executes its shift
!   |
!   |
!   v
!
!
!     
!
!              <-------  Parent executes its shift
!              
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!                         Scenario 2
!-----------------------------------------------------------------------
!
!              <-------  Parent decides it wants to shift
! 
!
!  TIME
!   |               <------  Child decides it wants to shift
!   |
!   |
!   v
!                   <------  Child executes its shift
!
!
!     
!
!              <-------  Parent executes its shift
!              
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!                         Scenario 3  (~equivalent to Scenario 2)
!-----------------------------------------------------------------------
!
!              <-------  Parent decides it wants to shift
! 
!
!  TIME
!   |
!   |
!   |
!   v
!                   <------  Child decides it wants to shift
!
!              <-------  Parent executes its shift
!     
!                   <------  Child executes its shift
!              
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
          MOVE_NOW=.TRUE.                                                  !<-- Yes, the child moves at beginning of this timestep
!
!         IF(NTRACK>0)THEN
!           I_CENTER_CURRENT=STORM_CENTER(1)                            &
!                            -(I_SW_PARENT_NEW-I_SW_PARENT_CURRENT)     &
!                             *SPACE_RATIO_MY_PARENT
!           J_CENTER_CURRENT=STORM_CENTER(2)                            &
!                            -(J_SW_PARENT_NEW-J_SW_PARENT_CURRENT)     &
!                             *SPACE_RATIO_MY_PARENT
!         ENDIF
!
          I_WANT_TO_MOVE=.FALSE.                                           !<-- Reset the 'move' flag
          MOVE_FLAG_SENT=.FALSE.                                           !<-- Reset the flag for ISending the move flag
!
!-----------------------------------------------------------------------
!***  Deallocate this moving nest's working arrays/pointers whose 
!***  dimensions are functions of moving nests' positions.  They will 
!***  be reallocated with dimensions appropriate for the new positions.
!***  For static nests the same nest arrays/pointers never become
!***  invalid and thus are not deallocated/reallocated.
!-----------------------------------------------------------------------
!
          CALL DEALLOC_WORK_CHILDREN(MY_DOMAIN_ID)                         !<-- Reset this child's working pointers for new location
!
!-----------------------------------------------------------------------
!***  Each child boundary task receives small information packets
!***  from the parent tasks that cover them.  That information
!***  can change with each move and includes the identities of 
!***  those parent tasks that will be sending boundary data
!***  updates along with the index limits on the child task of
!***  that boundary data from each parent task.
!-----------------------------------------------------------------------
!
          CALL CHILD_RECVS_CHILD_DATA_LIMITS(EXP_STATE,MY_DOMAIN_ID)       !<-- Recv specs of new parent/child task associations
!                                                                          !    for BC data.
!-----------------------------------------------------------------------
!***  Receive standard boundary data update from the parent valid for 
!***  the current timestep but now at the child's new location.  This
!***  data will be for time N in the boundary tendency computation:
!***  dX/dt = [ X(N+1) - X(N) ] / DT_parent
!-----------------------------------------------------------------------
!
          CALL NEST_RECVS_BC_DATA('Current')                               !<-- Recv parent data for new nest boundary after move
!
!-----------------------------------------------------------------------
!***  Receive update data for all interior points on the nest domain
!***  that have moved outside of the nest's pre-move footprint.  Those
!***  points can only be updated by the parent.  The index limits of
!***  the parent update regions on the nest tasks are identical for
!***  H and V points therefore the nest needs to call its bookkeeping
!***  only once.
!-----------------------------------------------------------------------
!
          IF(I_AM_LEAD_FCST_TASK)THEN
            WRITE(0,12341)MY_DOMAIN_ID,NTIMESTEP
            WRITE(0,12342)I_SHIFT_CHILD,J_SHIFT_CHILD                   &
                         ,I_SW_PARENT_NEW,J_SW_PARENT_NEW
12341       FORMAT(' Nest shifts now  my_domain_id=',I2,' ntimestep=',I6) 
12342       FORMAT(' i_shift_child=',I4,' j_shift_child=',I4            &
                  ,' i_sw_parent_new=',I4,' j_sw_parent_new=',I4)
          ENDIF
!
          btim=timef()
          CALL MOVING_NEST_BOOKKEEPING(I_SHIFT_CHILD                    &
                                      ,J_SHIFT_CHILD                    &
                                      ,I_SW_PARENT_NEW                  &
                                      ,J_SW_PARENT_NEW                  &
                                      ,NUM_FCST_TASKS_PARENT            &
                                      ,INPES_PARENT                     &
                                      ,PTASK_LIMITS(MY_DOMAIN_ID)%ITS   &
                                      ,PTASK_LIMITS(MY_DOMAIN_ID)%ITE   &
                                      ,PTASK_LIMITS(MY_DOMAIN_ID)%JTS   &
                                      ,PTASK_LIMITS(MY_DOMAIN_ID)%JTE   &
                                      ,SPACE_RATIO_MY_PARENT            &
                                      ,NROWS_P_UPD_W                    &
                                      ,NROWS_P_UPD_E                    &
                                      ,NROWS_P_UPD_S                    &
                                      ,NROWS_P_UPD_N                    &
                                      ,SEND_TASK                        &
                                      ,ITS,ITE,JTS,JTE                  &
                                      ,IMS,IME,JMS,JME                  &
                                      ,IDS,IDE,JDS,JDE                  &
                                        )
!
          btim=timef()
          CALL MOVING_NEST_RECV_DATA(COMM_TO_MY_PARENT                  &
                                    ,NTIMESTEP                          &
                                    ,NUM_FIELDS_MOVE_2D_H_I             &
                                    ,NUM_FIELDS_MOVE_2D_X_I             &
                                    ,NUM_FIELDS_MOVE_2D_H_R             &
                                    ,NUM_FIELDS_MOVE_2D_X_R             &
                                    ,NUM_LEVELS_MOVE_3D_H               &
                                    ,NUM_FIELDS_MOVE_2D_V               &
                                    ,NUM_LEVELS_MOVE_3D_V               &
                                    ,SEND_TASK                          &
                                    ,EXP_STATE                          &
                                        )
          moving_nest_update_tim=moving_nest_update_tim+(timef()-btim)
!
          I_SW_PARENT_CURRENT=I_SW_PARENT_NEW                              !<-- Reset the location of the nest's SW corner
          J_SW_PARENT_CURRENT=J_SW_PARENT_NEW                              !    in its parent's grid space.
!
        ENDIF the_child_moves 
!
!-----------------------------------------------------------------------
!***  Load the Attribute into the coupler export state indicating that 
!***  the child is or is not moving at this timestep.  This information 
!***  will be used in the transfer of the new data from the Parent-Child
!***  coupler export state to the Domain import state to the Solver
!***  import state.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Child Inserts Move Flag into Cpl Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent-Child coupler export state
                              ,name ='MOVE_NOW'                         &  !<-- Name of the attribute to insert
                              ,value=MOVE_NOW                           &  !<-- Is the child moving right now?
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------------------------------------------
!
      ENDIF moving_children_a
!
!-----------------------------------------------------------------------
!***  If this is a (moving) child of a moving parent then it needs
!***  to watch for the appearance of a signal from the parent
!***  indicating that it (the parent) intends to move.  The child 
!***  will use that shift information in two different ways. 
!***  If two-way interaction is being used then the child must know
!***  the direction of the parent's move and prepare/send the 2-way 
!***  data at the end of the parent timestep in which the parent
!***  shift took place.  Then for all nesting the child uses the
!***  new parent location at the beginning of the parent timestep
!***  in which the shift occurs to properly prepare working objects,
!***  to receive, and to incorporate standard BC update data that
!***  was sent from the parent at the end of the timestep of the 
!***  parent's shift.
!***  So in order to be ready for both those situations the child
!***  now receives the parent's shift and the new specifics of the
!***  parent task and nest task associations if this is the start
!***  of the parent timestep preceding the parent's shift.
!-----------------------------------------------------------------------
!
      moving_parent: IF(MY_PARENT_MOVES)THEN
!
!-----------------------------------------------------------------------
!
        PARENT_SHIFT_IS_PRESENT=.FALSE.
!
        IF(I_AM_LEAD_FCST_TASK)THEN
          NTAG0=PARENT_SHIFT_TAG+NTIMESTEP/TIME_RATIO_MY_PARENT            !<-- Unique timestep-dependent MPI tag.  It is valid one
                                                                           !    parent timestep after the parent decides to move.
          CALL MPI_IPROBE(0                                             &  !<-- The message is sent by moving parent's fcst task 0.
                         ,NTAG0                                         &  !<-- Tag associated with parent's shift
                         ,COMM_TO_MY_PARENT                             &  !<-- Communicator between this nest and its parent
                         ,PARENT_SHIFT_IS_PRESENT                       &  !<-- Is the parent's shift now available?
                         ,JSTAT                                         &
                         ,IERR)
!
          IF(PARENT_SHIFT_IS_PRESENT)THEN
            CALL MPI_RECV(PARENT_SHIFT                                  &  !<-- Recv the parent's shift
                         ,3                                             &  !<-- # of words in the message
                         ,MPI_INTEGER                                   &  !<-- The shifts in I and J are integers
                         ,0                                             &  !<-- Local rank of the parent task sending the word
                         ,NTAG0                                         &  !<-- Tag used for this data exchange
                         ,COMM_TO_MY_PARENT                             &  !<-- Communicator between this nest and its parent
                         ,JSTAT                                         &
                         ,IERR )
          ENDIF
!
        ENDIF
!
        CALL MPI_BCAST(PARENT_SHIFT_IS_PRESENT                          &  !<-- Has the new move timestep been received?
                      ,1                                                &  !<-- The signal is one word
                      ,MPI_LOGICAL                                      &  !<-- The signal is type Logical
                      ,0                                                &  !<-- Broadcast from nest forecast task 0
                      ,COMM_FCST_TASKS                                  &  !<-- MPI communicator for this nest's forecast tasks
                      ,IRTN)
!
        IF(PARENT_SHIFT_IS_PRESENT)THEN
!
          CALL MPI_BCAST(PARENT_SHIFT                                   &  !<-- Broadcast the parent shift
                        ,3                                              &  !<-- # of words in the message
                        ,MPI_INTEGER                                    &  !<-- The shifts in I and J are integers
                        ,0                                              &  !<-- Broadcast from nest forecast task 0
                        ,COMM_FCST_TASKS                                &  !<-- MPI communicator for this nest's forecast tasks
                        ,IRTN)
!
          PARENT_WANTS_TO_MOVE=.TRUE.
          NTIMESTEP_WAIT_PARENT=PARENT_SHIFT(1)*TIME_RATIO_MY_PARENT       !<-- This child domain's timestep in which
!                                                                          !    its parent will shift.
!
        ENDIF
!
        IF(NTIMESTEP==PARENT_SHIFT(1)*TIME_RATIO_MY_PARENT              &  !<-- Did the parent shift at the start of this parent timestep?
                    .AND.                                               &
           PARENT_SHIFT(1)>0)THEN
!
          I_SW_PARENT_CURRENT=I_SW_PARENT_CURRENT-PARENT_SHIFT(2)          !<-- Current parent I,J of SW corner of this child's domain
          J_SW_PARENT_CURRENT=J_SW_PARENT_CURRENT-PARENT_SHIFT(3)          !    after its parent shifts.
!
          I_SW_PARENT_NEW=I_SW_PARENT_NEW-PARENT_SHIFT(2)                  !<-- New parent I,J of SW corner of this child's domain
          J_SW_PARENT_NEW=J_SW_PARENT_NEW-PARENT_SHIFT(3)                  !    after the child and parent have shifted.
!
          CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                                ,name ='I_SW_PARENT_NEW'                &  !<-- Insert Attribute with this name
                                ,value=I_SW_PARENT_NEW                  &  !<-- Motion of nest in I on its grid
                                ,rc   =RC )
!
          CALL ESMF_AttributeSet(state=EXP_STATE                        &  !<-- The Parent-Child coupler export state
                                ,name ='J_SW_PARENT_NEW'                &  !<-- Insert Attribute with this name
                                ,value=J_SW_PARENT_NEW                  &  !<-- Motion of nest in J on its grid
                                ,rc   =RC )
!
          CALL DEALLOC_WORK_CHILDREN(MY_DOMAIN_ID)                         !<-- Reset this child's working pointers for 'new' location
!
          CALL CHILD_RECVS_CHILD_DATA_LIMITS(EXP_STATE,MY_DOMAIN_ID)       !<-- Parent/child bndry task associations
!
          IF(FORCED_PARENT_SHIFT)THEN
            I_WANT_TO_MOVE=.FALSE.                                         !<-- Now the child is free to compute its storm motion after
            FORCED_PARENT_SHIFT=.FALSE.                                    !    forcing its parent to shift due to close boundaries.
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF moving_parent
!
!-----------------------------------------------------------------------
!***  Children receive boundary data from their parents from one
!***  parent timestep in the future which will be put into the Parent-
!***  Child coupler export state on its way to the dynamics where it
!***  will be used to compute boundary tendencies through the next
!***  NN timesteps.  NN is the number of child timesteps per parent
!***  timestep.  This data will be for time N+1 in the boundary
!***  tendency computation:
!***  dX/dt = [ X(N+1) - X(N) ] / DT_parent
!
!***  Note that if this is a timestep at which a child has just moved,
!***  the child's location-dependent working pointers for the boundary
!***  data were already reset for the new location in the IF block for
!***  NTIMESTEP==NEXT_MOVE_TIMESTEP above.
!
!***  If the digital filter is running and this child is not active
!***  in it then it does not receive.
!-----------------------------------------------------------------------
!
      IF(FREE_FORECAST.OR.(DIG_FILTER.AND.I_AM_ACTIVE))THEN
!
        CALL NEST_RECVS_BC_DATA('Future')
!
      ENDIF
!
!-----------------------------------------------------------------------
!***   In telescoping moving nests only the innermost utilizes the
!***   storm center location from the storm tracker.  This prevents
!***   different generations of moving nests over the same storm
!***   from deciding to move in different ways.
!
!***   If the nest is forcing its parent to shift to avoid a 
!***   collision then it will not call the routine until it knows
!***   the parent has completed its evasive shift.
!
!***   If a nest's or its parent's poleward boundary has moved
!***   beyond the user-specified latitude limit then the nest
!***   is permanently immobilized.
!
!***  After taking the storm center location if the nest decides it 
!***  wants to move then the shift will be executed LAG_STEPS parent
!***  timesteps later in this routine immediately above.  By that
!***  time its parent will have learned that the nest wants to move
!***  and will have prepared BC and internal shift data valid at the
!***  proper timestep.
!-----------------------------------------------------------------------
!
      moving_children_b: IF(MY_DOMAIN_MOVES)THEN                           !<-- Select the moving nests
!
!-----------------------------------------------------------------------
!
        motion: IF(.NOT.I_WANT_TO_MOVE                                  &  !<-- Nest not waiting to shift from earlier call to routine
                         .AND.                                          &
                   .NOT.FORCED_PARENT_SHIFT                             &  !<-- Nest not immobilized after forcing its parent to shift
                         .AND.                                          &
                   .NOT.STOP_MY_MOTION)THEN                                !<-- Nest not immobilized at the specified latitude limit.
!
!-----------------------------------------------------------------------
!
          innermost: IF(NUM_CHILDREN==0)THEN                               !<-- Only innermost moving nests explicitly follow storms
!                                                                          !    whereas outer nests follow their inner nests.
!-----------------------------------------------------------------------
!
            IF (TRIM(MOVE_TYPE) == 'storm') THEN
!
!-----------------------------------------------------------------------
!***  The storm tracker determines the storm center on this domain's
!***  grid every NPHS*NTRACK timesteps.  If this is an appropriate
!***  timestep then extract the latest center location.
!-----------------------------------------------------------------------
!
            new_center:                                                 &
!
            IF(NTRACK>0                                                 &
                 .AND.                                                  &
               NTIMESTEP>0                                              &
                 .AND.                                                  &
               MOD(NTIMESTEP,NTRACK*NPHS)==0)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract storm center from P-C Cpl import state."
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              CALL ESMF_AttributeGet(state    =IMP_STATE                &
                                    ,name     ='Storm Center'           &  !<-- Name of the attribute to extract
                                    ,valueList=STORM_CENTER             &  !<-- I,J of the storm center on this grid.
                                    ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              I_DIFF=STORM_CENTER(1)-I_CENTER_CURRENT                      !<-- Distance in I,J from current to
              J_DIFF=STORM_CENTER(2)-J_CENTER_CURRENT                      !    new storm center.
!
!-----------------------------------------------------------------------
!***  If the child moves then its SW corner must shift from one parent
!***  H point to another which means the I and J shifts must be in
!***  integer multiples of SPACE_RATIO_MY_PARENT.  Adjust I_DIFF and
!***  J_DIFF given this constraint.
!-----------------------------------------------------------------------
!
              IF(MOD(I_DIFF,SPACE_RATIO_MY_PARENT)/=0)THEN
                PARENT_DIFF=REAL(I_DIFF)/REAL(SPACE_RATIO_MY_PARENT)
                IF(ABS(FRACTION(PARENT_DIFF))>0.5)THEN
                  I_DIFF=NINT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
                ELSE
                  I_DIFF=INT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
                ENDIF
              ENDIF
!
              IF(MOD(J_DIFF,SPACE_RATIO_MY_PARENT)/=0)THEN
                PARENT_DIFF=REAL(J_DIFF)/REAL(SPACE_RATIO_MY_PARENT)
                IF(ABS(FRACTION(PARENT_DIFF))>0.5)THEN
                  J_DIFF=NINT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
                ELSE
                  J_DIFF=INT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
                ENDIF
              ENDIF
!
              IF(MAX_SHIFT<999)THEN                                        !<-- If true the nest's shift distance is restricted.
                MAX_SHIFT_CHILD=MAX_SHIFT*SPACE_RATIO_MY_PARENT            !<-- Max shift in I and/or J on the nest's grid
                I_DIFF=MIN(MAX(I_DIFF,-MAX_SHIFT_CHILD),MAX_SHIFT_CHILD)
                J_DIFF=MIN(MAX(J_DIFF,-MAX_SHIFT_CHILD),MAX_SHIFT_CHILD)
              ENDIF
!
              I_SW_PARENT_NEW=I_SW_PARENT_CURRENT+I_DIFF/SPACE_RATIO_MY_PARENT
              J_SW_PARENT_NEW=J_SW_PARENT_CURRENT+J_DIFF/SPACE_RATIO_MY_PARENT
!
              I_WANT_TO_MOVE=.TRUE.
!
              IF(ABS(I_DIFF)==0.AND.ABS(J_DIFF)==0)THEN
                I_WANT_TO_MOVE=.FALSE.
                IF(I_AM_LEAD_FCST_TASK)THEN
                  WRITE(0,*)' NO MOTION: Less than one parent grid increment.'                                
                ENDIF
              ENDIF
!
            ENDIF new_center
!
!             CALL COMPUTE_STORM_MOTION(NTIMESTEP                       &
!                                      ,LAST_STEP_MOVED                 &
!                                      ,DT_DOMAIN(MY_DOMAIN_ID)         &
!                                      ,NUM_PES_FCST                    &
!                                      ,COMM_FCST_TASKS                 &
!                                      ,FIS                             &
!                                      ,PD                              &
!                                      ,PINT                            &
!                                      ,T                               &
!                                      ,Q                               &
!                                      ,CW                              &
!                                      ,U                               &
!                                      ,V                               &
!                                      ,DSG2                            &
!                                      ,PDSG1                           &
!                                      ,DXH                             &
!                                      ,DYH                             &
!                                      ,SM                              &
!                                      ,I_SW_PARENT_CURRENT             &
!                                      ,J_SW_PARENT_CURRENT             &
!                                      ,I_WANT_TO_MOVE                  &
!                                      ,I_SW_PARENT_NEW                 &
!                                      ,J_SW_PARENT_NEW                 &
!                                      ,MY_DOMAIN_ID )
!
            ELSE IF (TRIM(MOVE_TYPE) == 'prescribed') THEN

              CALL PRESCRIBED_MOVE(NTIMESTEP,DT_DOMAIN(MY_DOMAIN_ID)    &
                                   ,I_WANT_TO_MOVE                      &
                                   ,I_SW_PARENT_CURRENT                 &
                                   ,J_SW_PARENT_CURRENT                 &
                                   ,I_SW_PARENT_NEW                     &
                                   ,J_SW_PARENT_NEW )

!            ELSE IF (TRIM(MOVE_TYPE) == 'artificial5') THEN
!
!              CALL ARTIFICIAL_MOVE5(NTIMESTEP                           &
!                                   ,KOUNT_MOVES                         &
!                                   ,I_WANT_TO_MOVE                      &
!                                   ,I_SW_PARENT_CURRENT                 &
!                                   ,J_SW_PARENT_CURRENT                 &
!                                   ,I_SW_PARENT_NEW                     &
!                                   ,J_SW_PARENT_NEW )

            ELSE
   
              WRITE(0,*)' Unknown move type :', TRIM(MOVE_TYPE)
              WRITE(0,*)' ABORTING!'
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT)

            ENDIF
!
          ENDIF innermost
!
!-----------------------------------------------------------------------
!***  The motion of a moving parent is essentially determined by the
!***  motion of its child.  The parent watches the location of its
!***  child and when the distance between the centers of the two
!***  domains exceeds the specified value then the parent shifts in
!***  order to bring its center as close as possible to the child's.
!***  However that desired shift must also be great enough to span
!***  at least one of its own parent's grid increments since all
!***  nests move so that their SW corner coincides with an H point
!***  on their parent's grid.
!-----------------------------------------------------------------------
!
          outer: IF(NUM_CHILDREN>0                                      &  !<-- This moving child has a moving child.
                          .AND.                                         &
                    NTIMESTEP>NEXT_MOVE_TIMESTEP)THEN                      !<-- Wait 1 timestep after shifting before considering another.
!
!-----------------------------------------------------------------------
!
            N=1                                                            !<-- Moving nests can have only one child for now.
!
            CENTER_I_OUTER=0.5*(IDS+IDE)
            CENTER_J_OUTER=0.5*(JDS+JDE)
!
            CENTER_I_INNER=I_PARENT_SW(N)                               &
                          +0.5*(IM_CHILD(N)-1.)*CHILD_PARENT_SPACE_RATIO(N)
            CENTER_J_INNER=J_PARENT_SW(N)                               &
                          +0.5*(JM_CHILD(N)-1.)*CHILD_PARENT_SPACE_RATIO(N)
            DIFF_I=CENTER_I_INNER-CENTER_I_OUTER
            DIFF_J=CENTER_J_INNER-CENTER_J_OUTER
!
            DISTANCE=SQRT(DIFF_I**2+DIFF_J**2)                             !<-- Distance in outer nest grid increments
                                                                           !    between the outer and inner nest centers.
!
            I_SHIFT_PARENT_GRID=NINT(DIFF_I/REAL(SPACE_RATIO_MY_PARENT))   !<-- Prospective I shift on this nest's parent's grid.
            J_SHIFT_PARENT_GRID=NINT(DIFF_J/REAL(SPACE_RATIO_MY_PARENT))   !<-- Prospective J shift on this nest's parent's grid.
            I_SHIFT_MY_GRID=I_SHIFT_PARENT_GRID*SPACE_RATIO_MY_PARENT      !<-- Prospective I shift on this nest's grid.
            J_SHIFT_MY_GRID=J_SHIFT_PARENT_GRID*SPACE_RATIO_MY_PARENT      !<-- Prospective J shift on this nest's grid.
!
!-----------------------------------------------------------------------
!***  The outer moving nest now checks to see if the distance between 
!***  its center and its moving child's exceeds the pre-specified
!***  value.  If it does then it will set a prospective shift as 
!***  long as that shift will span at least one of its parent's grid 
!***  increments since all nest motion involves moving the SW corner
!***  of the nest domain from one parent H point to another. 
!-----------------------------------------------------------------------
!
            IF(DISTANCE>CENTERS_DISTANCE                                &  !<-- Inner nest center exceeds distance for outer nest shift.
                         .AND.                                          &
               (ABS(I_SHIFT_PARENT_GRID)>=1                             &  !<-- Outer nest shift must be at least
                         .OR.                                           &  !    one grid increment in I or J
                ABS(J_SHIFT_PARENT_GRID)>=1))THEN                          !    on its parent's grid.
!
              I_WANT_TO_MOVE=.TRUE.
!
              I_SW_PARENT_NEW=I_SW_PARENT_CURRENT+I_SHIFT_PARENT_GRID      !<-- This nest's SW corner will lie on this I and J
              J_SW_PARENT_NEW=J_SW_PARENT_CURRENT+J_SHIFT_PARENT_GRID      !    of its parent's domain after this shift.
!
!-----------------------------------------------------------------------
!***  This moving parent wants to shift since its and its childs
!***  centers are now too far apart.  However make sure the child
!***  is not already prepared to shift again.  If it is then the
!***  parent will not shift.
!-----------------------------------------------------------------------
!
              DO NN=1,NUM_CHILDREN
                IF(NTIMESTEP<=SHIFT_INFO_CHILDREN(1,NN)                 &
                                .AND.                                   &
                   SHIFT_INFO_CHILDREN(1,NN)                            &
                     <=NTIMESTEP+TIME_RATIO_MY_PARENT*LAG_STEPS)THEN
!
                  I_WANT_TO_MOVE=.FALSE.
                  I_SW_PARENT_NEW=I_SW_PARENT_CURRENT
                  J_SW_PARENT_NEW=J_SW_PARENT_CURRENT
!
                  IF(I_AM_LEAD_FCST_TASK)THEN
                    WRITE(0,51511)MY_DOMAIN_ID,NTIMESTEP                &
                                 ,N,SHIFT_INFO_CHILDREN(1,NN)
51511               FORMAT(' CHILDREN_RECV MY_DOMAIN_ID=',I2,' NTIMESTEP=',I6 &
                          ,' I wanted to move but child #',I2,' will shift at ',i6)
                    WRITE(0,51512)
51512               FORMAT(' So I will not shift.')
                  ENDIF
                ENDIF
              ENDDO
!
!-----------------------------------------------------------------------
!
            ENDIF
!
          ENDIF outer
!
!-----------------------------------------------------------------------
!
        ENDIF motion
!
!-----------------------------------------------------------------------
!***  If necessary account for the very special situation in which
!***  a child of this domain wants to move too close to this domain's 
!***  boundary.  When that happens then this domain is forced to 
!***  move to avoid the collision.
!-----------------------------------------------------------------------
!
        IF(CHILD_FORCES_MY_SHIFT)THEN
          I_WANT_TO_MOVE=.TRUE.
          MOVE_FLAG_SENT=.FALSE.
          I_SW_PARENT_NEW=I_SW_PARENT_CURRENT                           &
                          +NINT(MY_FORCED_SHIFT(1)*RECIP_PARENT_SPACE_RATIO)
          J_SW_PARENT_NEW=J_SW_PARENT_CURRENT                           &
                          +NINT(MY_FORCED_SHIFT(2)*RECIP_PARENT_SPACE_RATIO)
!
          IF(I_AM_LEAD_FCST_TASK)THEN
            WRITE(0,52053)I_WANT_TO_MOVE,MOVE_FLAG_SENT,MY_DOMAIN_ID,NTIMESTEP
            WRITE(0,52054)MY_FORCED_SHIFT(1),MY_FORCED_SHIFT(2)
52053       FORMAT(' CHILDREN_RECV child_forces_my_shift i_want_to_move=',L1,' move_flag_sent=',L1,' my_domain_id=',I2,' ntimestep=',I5)
52054       FORMAT(' my forced I shift=',i4,' my forced J shift=',I4)
          ENDIF
        ENDIF
!
!-----------------------------------------------------------------------
!***  If this child wants to shift and it knows that its parent
!***  had already initiated its own shift but has not yet moved
!***  then this child simply ignores its own desire to shift and
!***  waits NTIMESTEP_WAIT_PARENT after which its parent will
!***  have executed its shift.  The child will then be free to
!***  initiate a shift.
!-----------------------------------------------------------------------
!
        IF(I_WANT_TO_MOVE.AND.PARENT_WANTS_TO_MOVE)THEN
!
          I_WANT_TO_MOVE=.FALSE.
          I_SW_PARENT_NEW=I_SW_PARENT_CURRENT                  
          J_SW_PARENT_NEW=J_SW_PARENT_CURRENT
          NEXT_MOVE_TIMESTEP=-999
          MOVE_FLAG_SENT=.FALSE.
!
        ENDIF
!
        IF(NTIMESTEP_WAIT_PARENT>0                                      &  !<-- Parent has wanted to shift at least once
                   .AND.                                                &
           NTIMESTEP>NTIMESTEP_WAIT_PARENT-TIME_RATIO_MY_PARENT)THEN       !<-- Reset this brake 1 parent timestep before parent shifts.
          PARENT_WANTS_TO_MOVE=.FALSE.
        ENDIF
!
!-----------------------------------------------------------------------
!***  If the nest has decided it wants to shift then finalize the
!***  key values and inform the parent.
!-----------------------------------------------------------------------
!
        IF(I_WANT_TO_MOVE.AND..NOT.MOVE_FLAG_SENT)THEN                     !<-- Nest wants to move; shift info not already sent
!
!-----------------------------------------------------------------------
!***  If this child domain is also a parent then it must check to see
!***  if its shift would bring its children's domains too close to the
!***  parent boundary.  If it does then this domain must not shift.
!-----------------------------------------------------------------------
!
          DISTN_TO_PARENT_BNDRY=1.E6
!
          IF(NUM_CHILDREN>0)THEN
            DO N=1,NUM_CHILDREN
              I_SHIFT=(I_SW_PARENT_NEW-I_SW_PARENT_CURRENT)*SPACE_RATIO_MY_PARENT
              J_SHIFT=(J_SW_PARENT_NEW-J_SW_PARENT_CURRENT)*SPACE_RATIO_MY_PARENT
              CHILD_DOMAIN_EW=REAL(IM_CHILD(N)-1)/REAL(PARENT_CHILD_SPACE_RATIO(N))
              CHILD_DOMAIN_NS=REAL(JM_CHILD(N)-1)/REAL(PARENT_CHILD_SPACE_RATIO(N))
              DISTN_SOUTH=J_PARENT_SW(N)-J_SHIFT-JDS
              DISTN_NORTH=JDE-(J_PARENT_SW(N)+CHILD_DOMAIN_NS)+J_SHIFT
              DISTN_WEST =I_PARENT_SW(N)-I_SHIFT-IDS
              DISTN_EAST =IDE-(I_PARENT_SW(N)+CHILD_DOMAIN_EW)+I_SHIFT
              DISTN_TO_PARENT_BNDRY=MIN(DISTN_SOUTH,DISTN_NORTH         &
                                       ,DISTN_WEST,DISTN_EAST           &
                                       ,DISTN_TO_PARENT_BNDRY)
            ENDDO
          ENDIF
!
!-----------------------------------------------------------------------
!
          check_shift: IF(DISTN_TO_PARENT_BNDRY<=MIN_DIST_PARENT)THEN
!
            I_WANT_TO_MOVE=.FALSE.                                         !<-- Do not allow this domain (as a parent) to move.
!
            IF(NTIMESTEP>NTIMESTEP_WAIT_FORCED_PARENT)THEN                 !<-- If true, previous forced move of parent is done.
              I_SW_PARENT_NEW=I_SW_PARENT_CURRENT 
              J_SW_PARENT_NEW=J_SW_PARENT_CURRENT
            ENDIF
!
            IF(I_AM_LEAD_FCST_TASK)THEN
              WRITE(0,77771)MY_DOMAIN_ID,NTIMESTEP,DISTN_TO_PARENT_BNDRY
              WRITE(0,77772)I_SHIFT,J_SHIFT
              WRITE(0,77773)DISTN_SOUTH,DISTN_NORTH,DISTN_WEST,DISTN_EAST
77771         FORMAT(' DO NOT allow this parent to move my_domain_id=',i2 &
                    ,' ntimestep=',i5,' distn_to_parent_bndry=',e12.5)
77772         FORMAT(' Parent wanted to shift ',I3,3X,I3,' on its grid')
77773         FORMAT(' distn_south=',e12.5,' distn_north=',e12.5          &
                    ,' distn_west=',e12.5,' distn_east=',e12.5)
            ENDIF
!
          ELSE
!
!-----------------------------------------------------------------------
!***  First the child checks to see if the shift it wants to make
!***  will take it too near to the domain boundary of its parent.
!***  If it does then the child does not move and instead informs
!***  the parent that it must move far enough in the direction the
!***  child wants to move so that when the child does move then
!***  the child will not be too close to the parent boundary.
!***  The array PARENT_DOMAIN_LIMITS used below holds the west,
!***  east, south, and north index limits, respectively, of the
!***  parent domain.
!-----------------------------------------------------------------------
!
            CHILD_DOMAIN_EW=REAL(IDE-IDS)*RECIP_PARENT_SPACE_RATIO         !<-- E-W extent of child domain in terms of parent grid
            CHILD_DOMAIN_NS=REAL(JDE-JDS)*RECIP_PARENT_SPACE_RATIO         !<-- N-S extent of child domain in terms of parent grid
!
            DIST_SOUTH=J_SW_PARENT_NEW-PARENT_DOMAIN_LIMITS(3)                   !<-- Distance of child sbdry from parent sbdry
            DIST_NORTH=PARENT_DOMAIN_LIMITS(4)-(J_SW_PARENT_NEW+CHILD_DOMAIN_NS) !<-- Distance of child nbdry from parent nbdry
            DIST_WEST =I_SW_PARENT_NEW-PARENT_DOMAIN_LIMITS(1)                   !<-- Distance of child wbdry from parent wbdry
            DIST_EAST =PARENT_DOMAIN_LIMITS(2)-(I_SW_PARENT_NEW+CHILD_DOMAIN_EW) !<-- Distance of child ebdry from parent ebdry
!
            DIST_TO_PARENT_BNDRY=MIN(DIST_SOUTH,DIST_NORTH,DIST_WEST,DIST_EAST)  !<-- Min distance between child and parent boundaries
                                                                                 !    in terms of the parent grid.
!
!-----------------------------------------------------------------------
!
            parent_bdy: IF(DIST_TO_PARENT_BNDRY>MIN_DIST_PARENT)THEN       !<-- If true, the child is not too close to the parent boundary.
!
!-----------------------------------------------------------------------
!***  If this child's shift will take its poleward boundary beyond
!***  the latitude limit then let it execute that shift after which
!***  it will not move again.  Likewise if this child's parent is a
!***  moving nest and has reached the latitude limit then the child 
!***  must stop its own motion as the parent has already done.
!-----------------------------------------------------------------------
!
              J_SHIFT=J_SW_PARENT_NEW-J_SW_PARENT_CURRENT                  !<-- This nest's shift in terms of its parent's grid
              SHIFT_LAT=J_SHIFT*SPACE_RATIO_MY_PARENT*DPH                  !<-- This nest's shift in geographic latitude (rad)
              DOMAIN_NBND=GLAT(ITS,JTS)+DPH*(JDE-JTS)+SHIFT_LAT            !<-- Post-shift geog latitude (rad) of child's north bndry
              DOMAIN_SBND=GLAT(ITS,JTS)-DPH*(JTS-JDS)+SHIFT_LAT            !<-- Post-shift geog latitude (rad) of child's south bndry
!
              PARENT_NBND=((PARENT_DOMAIN_LIMITS(4)-J_SW_PARENT_NEW)    &  !<--
                           *SPACE_RATIO_MY_PARENT                       &  !    Geographic latitude (rad)
                           -(JTS-JDS))*DPH                              &  !    of parent's north boundary.
                          +GLAT(ITS,JTS)                                   !<--
!
              PARENT_SBND=((PARENT_DOMAIN_LIMITS(3)-J_SW_PARENT_NEW)    &  !<--
                           *SPACE_RATIO_MY_PARENT                       &  !    Geographic latitude (rad)
                           -(JTS-JDS))*DPH                              &  !    of parent's south boundary.
                          +GLAT(ITS,JTS)                                   !<--
!
              IF(DOMAIN_NBND>NORTH_LAT_MAX_MVG_NEST-EPS                 &  !<-- Has the nest's north boundary reached too far north?
                              .OR.                                      &
                 DOMAIN_SBND<SOUTH_LAT_MAX_MVG_NEST+EPS                 &  !<-- Has the nest's south boundary reached too far south?
                              .OR.                                      &
                         MY_PARENT_MOVES                                &  !<-- Is my parent a moving nest?
                              .AND.                                     &
                 (PARENT_NBND>NORTH_LAT_MAX_MVG_NEST-EPS                &  !<-- Has the parent's north boundary reached too far north?
                              .OR.                                      &
                  PARENT_SBND<SOUTH_LAT_MAX_MVG_NEST+EPS))THEN             !<-- Has the parent's south boundary reached too far south?
!
                STOP_MY_MOTION=.TRUE.                                      !<-- This domain will never move again.
!
              ENDIF
!
!-----------------------------------------------------------------------
!***  Do not permit the nest to shift at what would be the first
!***  timestep of a restarted run.  That is because of the large
!***  amount of move-related information exchanged between the
!***  nest and its parent across timesteps.  Also do not let the
!***  nest shift very near the end of the forecast.
!-----------------------------------------------------------------------
!
              IF(NTIMESTEPS_RESTART-MOD(NTIMESTEP,NTIMESTEPS_RESTART)>TIME_RATIO_MY_PARENT*LAG_STEPS &
                                           .AND.                                                     &
                 NTIMESTEP<NTIMESTEP_FINAL-TIME_RATIO_MY_PARENT*(LAG_STEPS+1))THEN
!
!-----------------------------------------------------------------------
!
                IF(.NOT.STOP_MY_MOTION)THEN
                  NEXT_MOVE_TIMESTEP=NTIMESTEP+TIME_RATIO_MY_PARENT*LAG_STEPS  !<-- Nest will shift after LAG_STEPS parent timesteps
                ENDIF
!
                NEXT_MOVE_TIMESTEP_PARENT=NEXT_MOVE_TIMESTEP/TIME_RATIO_MY_PARENT  !<-- Nest will shift after LAG_STEPS parent timesteps
                LAST_STEP_MOVED=NEXT_MOVE_TIMESTEP                                 !<-- Reset to this to the most recent move
!
!-----------------------------------------------------------------------
!
                IF(I_AM_LEAD_FCST_TASK)THEN                                !<-- Lead forecast task on this moving nest
!
                  CALL MPI_WAIT(HANDLE_MOVE_FLAG                        &  !<-- Handle for ISend of child's move flag to parent
                               ,JSTAT                                   &  !<-- MPI status
                               ,IERR)
!
                  MOVE_TAG=1111+10*MY_DOMAIN_ID+25*ID_PARENTS(MY_DOMAIN_ID)  !<-- Unique MPI tag uses child and parent domain IDs
!
                  SHIFT_INFO_MINE(1)=NEXT_MOVE_TIMESTEP_PARENT             !<-- Nest will shift at start of this parent timestep
                  SHIFT_INFO_MINE(2)=I_SW_PARENT_NEW-I_SW_PARENT_CURRENT   !<-- Nest's shift in I on its parent's grid
                  SHIFT_INFO_MINE(3)=J_SW_PARENT_NEW-J_SW_PARENT_CURRENT   !<-- Nest's shift in J on its parent's grid

!
                  IF(STOP_MY_MOTION)THEN
                    SHIFT_INFO_MINE(4)=-22222                              !<-- Signal to parent that the child will not move again.
                  ENDIF
!
                  CALL MPI_ISSEND(SHIFT_INFO_MINE                       &  !<-- Key shift information 
                                 ,4                                     &  !<-- There are 3 words in the flag
                                 ,MPI_INTEGER                           &  !<-- Signal is type Integer
                                 ,0                                     &  !<-- Signal sent to parent task 0
                                 ,MOVE_TAG                              &  !<-- Arbitrary tag used for this data exchange
                                 ,COMM_TO_MY_PARENT                     &  !<-- MPI communicator between this child and its parent
                                 ,HANDLE_MOVE_FLAG                      &  !<-- Communication request handle for ISend to parent
                                 ,IERR )
!
                ENDIF
!
                MOVE_FLAG_SENT=.TRUE.
!
                IF(CHILD_FORCES_MY_SHIFT)THEN
                  CHILD_FORCES_MY_SHIFT=.FALSE.                            !<-- If my child forced this move then reset the flag now.
                ENDIF
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Insert NEXT_MOVE_TIMESTEP into P-C export start"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='NEXT_MOVE_TIMESTEP'       &  !<-- Insert Attribute with this name
                                      ,value=NEXT_MOVE_TIMESTEP         &  !<-- Nest will shift during this timestep
                                      ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
                I_SHIFT_CHILD=(I_SW_PARENT_NEW-I_SW_PARENT_CURRENT)     &  !<-- The shift in I in this domain's space
                              *SPACE_RATIO_MY_PARENT
                J_SHIFT_CHILD=(J_SW_PARENT_NEW-J_SW_PARENT_CURRENT)     &  !<-- The shift in J in this domain's space
                              *SPACE_RATIO_MY_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Insert I_SHIFT/J_SHIFT in RUN_RECV"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='I_SHIFT'                  &  !<-- Insert Attribute with this name
                                      ,value=I_SHIFT_CHILD              &  !<-- Motion of nest in I on its grid
                                      ,rc   =RC )
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='J_SHIFT'                  &  !<-- Insert Attribute with this name
                                      ,value=J_SHIFT_CHILD              &  !<-- Motion of nest in J on its grid
                                      ,rc   =RC )
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='I_SW_PARENT_NEW'          &  !<-- Insert Attribute with this name
                                      ,value=I_SW_PARENT_NEW            &  !<-- Motion of nest in I on its grid
                                      ,rc   =RC )
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='J_SW_PARENT_NEW'          &  !<-- Insert Attribute with this name
                                      ,value=J_SW_PARENT_NEW            &  !<-- Motion of nest in J on its grid
                                      ,rc   =RC )
!
                CALL ESMF_AttributeSet(state=EXP_STATE                  &  !<-- The Parent-Child coupler export state
                                      ,name ='LAST_STEP_MOVED'          &  !<-- Insert Attribute with this name
                                      ,value=LAST_STEP_MOVED            &  !<-- Motion of nest in J on its grid
                                      ,rc   =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  If this child wants to shift too soon after a restart output
!***  time or too near the end of the forecast then its desire to
!***  do so is ignored.
!-----------------------------------------------------------------------
!
              ELSE
!
                I_WANT_TO_MOVE=.FALSE.
!
!-----------------------------------------------------------------------
!
              ENDIF
!
!-----------------------------------------------------------------------
!***  The child wants to move too close to its parent's boundary.
!***  The child will not shift and what would have been its shift
!***  message will instead tell the parent it must move in a
!***  direction similar to what the child wanted to move.  However
!***  if the parent's domain is static then the child ignores its
!***  desire to shift and proceeds.
!-----------------------------------------------------------------------
!
            ELSE parent_bdy                                                !<-- Child shift would put it too close to parent boundary.
!
              IF(MY_PARENT_MOVES)THEN
!
                IF(NTIMESTEP>NTIMESTEP_WAIT_FORCED_PARENT)THEN             !<-- If true, previous forced move of parent is done.
!
                  FORCED_PARENT_SHIFT=.TRUE.                               !<-- Flag remains true until the parent shifts as told.
!
                  IF(I_AM_LEAD_FCST_TASK)THEN                              !<-- Lead forecast task on this moving nest
!
                    CALL MPI_WAIT(HANDLE_MOVE_FLAG                      &  !<-- Handle for ISend of child's move flag to parent
                                 ,JSTAT                                 &  !<-- MPI status
                                 ,IERR)
!
                    SHIFT_INFO_MINE(1)=-11111                              !<-- This tells the parent it is being forced to shift.
!
                    IF(DIST_WEST<=MIN_DIST_PARENT)THEN
                      SHIFT_INFO_MINE(2)=-MAX_FORCED_SHIFT                 !<-- Child pushes parent to the west (parent grid increments)
                    ELSEIF(DIST_EAST<=MIN_DIST_PARENT)THEN
                      SHIFT_INFO_MINE(2)=MAX_FORCED_SHIFT                  !<-- Child pushes parent to the east (parent grid increments)
                    ENDIF
!
                    IF(DIST_SOUTH<=MIN_DIST_PARENT)THEN
                      SHIFT_INFO_MINE(3)=-MAX_FORCED_SHIFT                 !<-- Child pushes parent to the south (parent grid increments)
                    ELSEIF(DIST_NORTH<=MIN_DIST_PARENT)THEN
                      SHIFT_INFO_MINE(3)=MAX_FORCED_SHIFT                  !<-- Child pushes parent to the north (parent grid increments)
                    ENDIF
!
                    MOVE_TAG=1111+10*MY_DOMAIN_ID+25*ID_PARENTS(MY_DOMAIN_ID)  !<-- Unique MPI tag uses child and parent domain IDs
!
                    CALL MPI_ISSEND(SHIFT_INFO_MINE                     &  !<-- Key shift information
                                   ,4                                   &  !<-- There are 3 words in the flag
                                   ,MPI_INTEGER                         &  !<-- Signal is type Integer
                                   ,0                                   &  !<-- Signal sent to parent task 0
                                   ,MOVE_TAG                            &  !<-- Arbitrary tag used for this data exchange
                                   ,COMM_TO_MY_PARENT                   &  !<-- MPI communicator between this child and its parent
                                   ,HANDLE_MOVE_FLAG                    &  !<-- Communication request handle for ISend to parent
                                   ,IERR )
!
                    WRITE(0,55551)MY_DOMAIN_ID,NTIMESTEP
                    WRITE(0,55552)SHIFT_INFO_MINE,MOVE_TAG
55551               FORMAT(' CHILDREN_RECV forcing parent to shift'     &
                          ,' my_domain_id=',I2,' ntimestep=',I5)
55552               FORMAT(' SHIFT_INFO=',4(1X,I6),' move_tag=',I6)
!
                  ENDIF
!
!-----------------------------------------------------------------------
!***  This child has just sent its parent a message saying that the
!***  parent must shift because the child's desired shift would
!***  otherwise cause a collision between the two domains' boundaries.
!***  The parent will not be able to act on this until the start of
!***  the following parent timestep and then must wait for LAG_STEPS
!***  timesteps of its own parent before executing its shift.  This
!***  child must not initiate another forced shift of its parent 
!***  until after that amount of time which is LAG_STEPS+1 of this
!***  child's grandparent's timesteps from now.
!-----------------------------------------------------------------------
!
                  ID_GRANDPARENT=ID_PARENTS(ID_PARENTS(MY_DOMAIN_ID))      !<-- My parent's parent's domain ID
                  DT_GRANDPARENT=DT_DOMAIN(ID_GRANDPARENT)                 !<-- My parent's parent's timestep interval (sec)
!
                  NTIMESTEP_WAIT_FORCED_PARENT=NTIMESTEP                          &  !<--  The next timestep this domain
                                               +NINT(DT_GRANDPARENT*(LAG_STEPS+1) &  !     will be allowed to initiate a
                                                    /DT_DOMAIN(MY_DOMAIN_ID))        !     forced move of its parent.
!
                ENDIF
!
!-----------------------------------------------------------------------
!
              ELSE                                                         !<-- This child's parent is static.
!
                I_WANT_TO_MOVE=.FALSE.                                     !<-- The parent cannot be pushed so do nothing.
!
                WRITE(0,55553)MY_DOMAIN_ID,NTIMESTEP
                WRITE(0,55554)
                WRITE(0,55555)
55553           FORMAT(' CHILDREN_RECV my_domain_id=',I2                &
                      ,' ntimestep=',I5)
55554           FORMAT(' Child wants to move too close to parent bndry!')
55555           FORMAT(' Parent cannot be pushed away so do not shift.')
!
!-----------------------------------------------------------------------
!
              ENDIF
!
!-----------------------------------------------------------------------
!
            ENDIF parent_bdy
!
!-----------------------------------------------------------------------
!
          ENDIF check_shift
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF moving_children_b
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!
      SUBROUTINE NEST_RECVS_BC_DATA(TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  A nest receives boundary data from its parent so that
!***  it can compute boundary tendencies for its integration.
!***  This is an internal subroutine to CHILDREN_RECV_PARENT_DATA.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      CHARACTER(len=*),INTENT(IN) :: TIME_FLAG                             !<-- BC data valid for current or future timestep?
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ID_ADD,IERR,N,NP_H,NP_V,NTAG
!
      integer(kind=kint) :: mype_intra
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Point at the memory valid for this particular domain
!***  since individual tasks might lie on more than one domain.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Each child task that holds part of the domain boundary receives
!***  data from the parent tasks that cover its boundary points.  
!***  This occurs for two different situations:
!***   (1) All nests receive boundary data from their parents that was
!***       sent from one parent timestep in the future.  That allows
!***       each nest to compute boundary value tendencies that are
!***       applied through the next NN child timesteps of integration
!***       where NN is the number of child timesteps within each parent
!***       timestep.
!***   (2) Immediately after a moving nest moves, it needs new boundary
!***       values for that current time at the new location.  The
!***       structure of that boundary data is the same as in (1) so
!***       it is received from the parents in the same way.  However
!***       that data then needs to be stored as the values for current
!***       parent timestep N where the boundary tendency for variable X
!***       is [X(N+1)-X(N)]/DT(parent).  The values from the future 
!***       timestep N+1 will subsequently be received as usual.
!
!***  Thus we simply need to know whether the incoming data is for the
!***  future time (#1 above) or for the current time (#2 above).  That
!***  information is given by this subroutine's input argument.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
!***  Now for each side of the nests' boundaries:
!
!***   (a) Each child task receives all boundary data from the
!***       relevant parent task(s).  Note that more than one 
!***       parent task might send to each child task and there may
!***       be overlap due to haloes.
!***   (b) The child tasks separate the data received from each of
!***       the parent tasks and combines them into unified segments
!***       on the boundary for each variable.
!***   (c) All boundary data is loaded into the Parent-Child Coupler's
!***       export state.
!
!-----------------------------------------------------------------------
!
      cpl1_prelim_tim=cpl1_prelim_tim+(timef()-btim0)
!
      ID_ADD=1000*MY_DOMAIN_ID
!
!--------------------
!***  South H Points
!--------------------
!
      btim0=timef()
!
      NP_H=NUM_PARENT_TASKS_SENDING_H%SOUTH                                !<-- # of parent tasks sending south boundary H data
!
      IF(NP_H>0)THEN
!
        NTAG=NTIMESTEP+101+ID_ADD                                          !<-- Add 101 and domain ID to obtain a unique south H tag
!
        DO N=1,NP_H                                                        !<-- Loop over each parent task sending Sboundary H data
          call date_and_time(values=values)     
!         write(0,123)n,parent_task(n)%south_h%id_source,values(5),values(6),values(7),values(8)
  123     format(' Ready to recv South_H from parent task #',i1,' id=',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
!     if(my_domain_id==4.and.ntimestep>=15516)then
!       write(0,39571)trim(time_flag)
!       write(0,39572)n,PARENT_TASK(N)%SOUTH_H%ID_SOURCE,PARENT_TASK(N)%SOUTH_H%LENGTH,ntag,np_h
39571   format(' NEST_RECVS_BC_DATA(',a7,') for South_H')
39572   format(' from parent task #',i3,' id=',i3,' # words=',i5,' ntag=',i6,' # parent tasks sending=',i2)
!     endif
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%SOUTH_H%STRING                   &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%SOUTH_H%LENGTH                   &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%SOUTH_H%ID_SOURCE                &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_south_h_recv_tim=cpl1_south_h_recv_tim+(timef()-btim)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
          call date_and_time(values=values)     
!         write(0,124)n,parent_task(n)%south_h%id_source,values(5),values(6),values(7),values(8)
  124     format(' Recvd South_H from parent task #',i1,' id=',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
! 
!-----------------------------------------------------------------------
!
          btim=timef()
          CALL CHILD_DATA_FROM_STRING(length_data=PARENT_TASK(N)%SOUTH_H%LENGTH     &  !<-- Length of parent datastring
                                     ,datastring =PARENT_TASK(N)%SOUTH_H%STRING     &  !<-- Parent datastring of child task bndry segment 
                                     ,ilim_lo    =INDX_MIN_H%SOUTH                  &  !<-- Lower I limit of child's segment of boundary
                                     ,ilim_hi    =INDX_MAX_H%SOUTH                  &  !<-- Upper I limit of child's segment of boundary
                                     ,jlim_lo    =1                                 &  !<-- Lower J limit of child's segment of boundary
                                     ,jlim_hi    =N_BLEND_H                         &  !<-- Upper J limit of child's segment of boundary
                                     ,i_start    =PARENT_TASK(N)%SOUTH_H%INDX_START &  !<-- Child's segment Istart on each parent task
                                     ,i_end      =PARENT_TASK(N)%SOUTH_H%INDX_END   &  !<-- Child's segment Iend on each parent task
                                     ,j_start    =1                                 &  !<-- Child's segment Jstart on each parent task
                                     ,j_end      =N_BLEND_H                         &  !<-- Child's segment Jend on each parent task
                                     ,nvars_bc_2d_h =NVARS_BC_2D_H                  &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h =NVARS_BC_3D_H                  &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h =NVARS_BC_4D_H                  &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d    =LBND_4D                           &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d    =UBND_4D                           &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v =NVARS_BC_2D_V                  &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v =NVARS_BC_3D_V                  &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,pdb        =PDB_S                             &  !<-- Child's 1-D segment of PD on Sbndry
                                     ,bc_vars_h  =MY_BC_VARS_H_S )                     !<-- Child's 1-D segment of other H-pt vbls on Sbndry
!
          cpl1_south_h_undo_tim=cpl1_south_h_undo_tim+(timef()-btim)
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        btim=timef()
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,pdb          =PDB_S                  &  !<-- Child's 1-D segment of PD on Sbndry
                                  ,bc_vars_h    =MY_BC_VARS_H_S         &  !<-- Child's 1-D segment of other H-pt vbls on Sbndry
                                  ,ilim_lo      =INDX_MIN_H%SOUTH       &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =INDX_MAX_H%SOUTH       &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =1                      &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =N_BLEND_H              &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='SOUTH_H_'//TIME_FLAG  &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_SOUTH_H       &  !<-- Combined boundary segment H data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
          cpl1_south_h_exp_tim=cpl1_south_h_exp_tim+(timef()-btim)
      ENDIF
!
      cpl1_south_h_tim=cpl1_south_h_tim+(timef()-btim0)
!
!--------------------
!***  South V Points
!--------------------
!
      btim0=timef()
!
      NP_V=NUM_PARENT_TASKS_SENDING_V%SOUTH                                !<-- # of parent tasks sending south boundary V data
!
      IF(NP_V>0)THEN
        NTAG=NTIMESTEP+102+ID_ADD                                          !<-- Add 102 and domain ID to obtain a unique south V tag
!
        DO N=1,NP_V                                                        !<-- Loop over each parent task sending Sboundary V data
!
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%SOUTH_V%STRING                   &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%SOUTH_V%LENGTH                   &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%SOUTH_V%ID_SOURCE                &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_south_v_recv_tim=cpl1_south_v_recv_tim+(timef()-btim)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
          call date_and_time(values=values)     
!         write(0,125)n,parent_task(n)%south_v%id_source,values(5),values(6),values(7),values(8)
  125     format(' Recvd South_V from parent task #',i1,' id=',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
!-----------------------------------------------------------------------
!
          btim=timef()
          CALL CHILD_DATA_FROM_STRING(length_data=PARENT_TASK(N)%SOUTH_V%LENGTH     &  !<-- Length of parent datastring
                                     ,datastring =PARENT_TASK(N)%SOUTH_V%STRING     &  !<-- Parent datastring of child task bndry segment
                                     ,ilim_lo    =INDX_MIN_V%SOUTH                  &  !<-- Lower I limit of child's segment of boundary
                                     ,ilim_hi    =INDX_MAX_V%SOUTH                  &  !<-- Upper I limit of child's segment of boundary
                                     ,jlim_lo    =1                                 &  !<-- Lower J limit of child's segment of boundary
                                     ,jlim_hi    =N_BLEND_V                         &  !<-- Upper J limit of child's segment of boundary
                                     ,i_start    =PARENT_TASK(N)%SOUTH_V%INDX_START &  !<-- Child's segment Istart on each parent task
                                     ,i_end      =PARENT_TASK(N)%SOUTH_V%INDX_END   &  !<-- Child's segment Iend on each parent task
                                     ,j_start    =1                                 &  !<-- Child's segment Jstart on each parent task
                                     ,j_end      =N_BLEND_V                         &  !<-- Child's segment Jend on each parent task
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                   &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                   &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                   &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d    =LBND_4D                           &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d    =UBND_4D                           &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                   &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                   &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,bc_vars_v  =MY_BC_VARS_V_S )                     !<-- Child's 1-D segment of V-pt vbls on Sbndry
          cpl1_south_v_undo_tim=cpl1_south_v_undo_tim+(timef()-btim)
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        btim=timef()
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,bc_vars_v    =MY_BC_VARS_V_S         &  !<-- Child's 1-D segment of V-pt vbls on Sbndry
                                  ,ilim_lo      =INDX_MIN_V%SOUTH       &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =INDX_MAX_V%SOUTH       &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =1                      &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =N_BLEND_V              &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='SOUTH_V_'//TIME_FLAG  &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_SOUTH_V       &  !<-- Combined boundary segment V data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
        cpl1_south_v_exp_tim=cpl1_south_v_exp_tim+(timef()-btim)
!
      ENDIF
!
      cpl1_south_v_tim=cpl1_south_v_tim+(timef()-btim0)
!
!--------------------
!***  North H Points
!--------------------
!
      btim0=timef()
!
      NP_H=NUM_PARENT_TASKS_SENDING_H%NORTH                                !<-- # of parent tasks sending north boundary H data
!
      IF(NP_H>0)THEN
        NTAG=NTIMESTEP+103+ID_ADD                                          !<-- Add 103 and domain ID to obtain a unique north H tag
!
        DO N=1,NP_H                                                        !<-- Loop over each parent task sending Nboundary H data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%NORTH_H%STRING                   &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%NORTH_H%LENGTH                   &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%NORTH_H%ID_SOURCE                &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%NORTH_H%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%NORTH_H%STRING     & 
                                     ,ilim_lo      =INDX_MIN_H%NORTH                  &
                                     ,ilim_hi      =INDX_MAX_H%NORTH                  &
                                     ,jlim_lo      =1                                 &
                                     ,jlim_hi      =N_BLEND_H                         &
                                     ,i_start      =PARENT_TASK(N)%NORTH_H%INDX_START &
                                     ,i_end        =PARENT_TASK(N)%NORTH_H%INDX_END   &
                                     ,j_start      =1                                 &
                                     ,j_end        =N_BLEND_H                         &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                     &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                     &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                     &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                           &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                           &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                     &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                     &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,pdb          =PDB_N                             &  !<-- Child's 1-D segment of PD on Nbndry
                                     ,bc_vars_h    =MY_BC_VARS_H_N )                     !<-- Child's 1-D segment of other H-pt vbls on Nbndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,pdb          =PDB_N                  &  !<-- Child's 1-D segment of PD on Nbndry
                                  ,bc_vars_h    =MY_BC_VARS_H_N         &  !<-- Child's 1-D segment of other H-pt vbls on Nbndry
                                  ,ilim_lo      =INDX_MIN_H%NORTH       &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =INDX_MAX_H%NORTH       &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =1                      &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =N_BLEND_H              &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='NORTH_H_'//TIME_FLAG  &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_NORTH_H       &  !<-- Combined boundary segment H data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_north_h_tim=cpl1_north_h_tim+(timef()-btim0)
!
!--------------------
!***  North V Points
!--------------------
!
      btim0=timef()
!
      NP_V=NUM_PARENT_TASKS_SENDING_V%NORTH                                !<-- # of parent tasks sending north boundary V data
!
      IF(NP_V>0)THEN
        NTAG=NTIMESTEP+104+ID_ADD                                          !<-- Add 104 and domain ID to obtain a unique north V tag
!
        DO N=1,NP_V                                                        !<-- Loop over each parent task sending Nboundary V data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%NORTH_V%STRING                   &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%NORTH_V%LENGTH                   &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%NORTH_V%ID_SOURCE                &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%NORTH_V%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%NORTH_V%STRING     & 
                                     ,ilim_lo      =INDX_MIN_V%NORTH                  &
                                     ,ilim_hi      =INDX_MAX_V%NORTH                  &
                                     ,jlim_lo      =1                                 &
                                     ,jlim_hi      =N_BLEND_V                         &
                                     ,i_start      =PARENT_TASK(N)%NORTH_V%INDX_START &
                                     ,i_end        =PARENT_TASK(N)%NORTH_V%INDX_END   &
                                     ,j_start      =1                                 &
                                     ,j_end        =N_BLEND_V                         &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                     &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                     &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                     &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                           &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                           &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                     &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                     &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,bc_vars_v    =MY_BC_VARS_V_N )                     !<-- Child's 1-D segment of V-pt vbls on Nbndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,bc_vars_v    =MY_BC_VARS_V_N         &  !<-- Child's 1-D segment of V-pt vbls on Nbndry
                                  ,ilim_lo      =INDX_MIN_V%NORTH       &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =INDX_MAX_V%NORTH       &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =1                      &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =N_BLEND_V              &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='NORTH_V_'//TIME_FLAG  &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_NORTH_V       &  !<-- Combined boundary segment V data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_north_v_tim=cpl1_north_v_tim+(timef()-btim0)
!
!-------------------
!***  West H Points
!-------------------
!
      btim0=timef()
!
      NP_H=NUM_PARENT_TASKS_SENDING_H%WEST                                 !<-- # of parent tasks sending west boundary H data
!
      IF(NP_H>0)THEN
        NTAG=NTIMESTEP+105+ID_ADD                                          !<-- Add 105 and domain ID to obtain a unique west H tag
!
        DO N=1,NP_H                                                        !<-- Loop over each parent task sending Wboundary H data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%WEST_H%STRING                    &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%WEST_H%LENGTH                    &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%WEST_H%ID_SOURCE                 &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%WEST_H%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%WEST_H%STRING     & 
                                     ,ilim_lo      =1                                &
                                     ,ilim_hi      =N_BLEND_H                        &
                                     ,jlim_lo      =INDX_MIN_H%WEST                  &
                                     ,jlim_hi      =INDX_MAX_H%WEST                  &
                                     ,i_start      =1                                &
                                     ,i_end        =N_BLEND_H                        &
                                     ,j_start      =PARENT_TASK(N)%WEST_H%INDX_START &
                                     ,j_end        =PARENT_TASK(N)%WEST_H%INDX_END   &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                          &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                          &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                    &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,pdb          =PDB_W                            &  !<-- Child's 1-D segment of PD on Wbndry
                                     ,bc_vars_h    =MY_BC_VARS_H_W )                    !<-- Child's 1-D segment of other H-pt vbls on Wbndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,pdb          =PDB_W                  &  !<-- Child's 1-D segment of PD on Wbndry
                                  ,bc_vars_h    =MY_BC_VARS_H_W         &  !<-- Child's 1-D segment of other H-pt vbls on Wbndry
                                  ,ilim_lo      =1                      &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =N_BLEND_H              &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =INDX_MIN_H%WEST        &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =INDX_MAX_H%WEST        &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='WEST_H_'//TIME_FLAG   &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_WEST_H        &  !<-- Combined boundary segment H data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_west_h_tim=cpl1_west_h_tim+(timef()-btim0)
!
!-------------------
!***  West V Points
!-------------------
!
      btim0=timef()
!
      NP_V=NUM_PARENT_TASKS_SENDING_V%WEST                                 !<-- # of parent tasks sending west boundary V data
!
      IF(NP_V>0)THEN
        NTAG=NTIMESTEP+106+ID_ADD                                          !<-- Add 106 and domain ID to obtain a unique west V tag
!
        DO N=1,NP_V                                                        !<-- Loop over each parent task sending Sboundary V data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%WEST_V%STRING                    &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%WEST_V%LENGTH                    &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%WEST_V%ID_SOURCE                 &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%WEST_V%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%WEST_V%STRING     & 
                                     ,ilim_lo      =1                                &
                                     ,ilim_hi      =N_BLEND_V                        &
                                     ,jlim_lo      =INDX_MIN_V%WEST                  &
                                     ,jlim_hi      =INDX_MAX_V%WEST                  &
                                     ,i_start      =1                                &
                                     ,i_end        =N_BLEND_V                        &
                                     ,j_start      =PARENT_TASK(N)%WEST_V%INDX_START &
                                     ,j_end        =PARENT_TASK(N)%WEST_V%INDX_END   &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                          &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                          &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                    &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,bc_vars_v    =MY_BC_VARS_V_W )                    !<-- Child's 1-D segment of V-pt vbls on Wbndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,bc_vars_v    =MY_BC_VARS_V_W         &  !<-- Child's 1-D segment of V-pt vbls on Wbndry
                                  ,ilim_lo      =1                      &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =N_BLEND_V              &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =INDX_MIN_V%WEST        &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =INDX_MAX_V%WEST        &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='WEST_V_'//TIME_FLAG   &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_WEST_V        &  !<-- Combined boundary segment V data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_west_v_tim=cpl1_west_v_tim+(timef()-btim0)
!
!-------------------
!***  East H Points
!-------------------
!
      btim0=timef()
!
      NP_H=NUM_PARENT_TASKS_SENDING_H%EAST                                 !<-- # of parent tasks sending east boundary H data
!
      IF(NP_H>0)THEN
        NTAG=NTIMESTEP+107+ID_ADD                                          !<-- Add 107 and domain ID to obtain a unique east H tag
!
        DO N=1,NP_H                                                        !<-- Loop over each parent task sending Eboundary H data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%EAST_H%STRING                    &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%EAST_H%LENGTH                    &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%EAST_H%ID_SOURCE                 &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%EAST_H%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%EAST_H%STRING     & 
                                     ,ilim_lo      =1                                &
                                     ,ilim_hi      =N_BLEND_H                        &
                                     ,jlim_lo      =INDX_MIN_H%EAST                  &
                                     ,jlim_hi      =INDX_MAX_H%EAST                  &
                                     ,i_start      =1                                &
                                     ,i_end        =N_BLEND_H                        &
                                     ,j_start      =PARENT_TASK(N)%EAST_H%INDX_START &
                                     ,j_end        =PARENT_TASK(N)%EAST_H%INDX_END   &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                          &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                          &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                    &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,pdb          =PDB_E                            &  !<-- Child's 1-D segment of PD on Ebndry
                                     ,bc_vars_h    =MY_BC_VARS_H_E )                    !<-- Child's 1-D segment of other H-pt vbls on Ebndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,pdb          =PDB_E                  &  !<-- Child's 1-D segment of PD on Ebndry
                                  ,bc_vars_h    =MY_BC_VARS_H_E         &  !<-- Child's 1-D segment of other H-pt vbls on Ebndry
                                  ,ilim_lo      =1                      &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi      =N_BLEND_H              &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo      =INDX_MIN_H%EAST        &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi      =INDX_MAX_H%EAST        &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name    ='EAST_H_'//TIME_FLAG   &  !<-- Name attached to the combined exported data
                                  ,data_exp     =BOUND_1D_EAST_H        &  !<-- Combined boundary segment H data for child task
                                  ,export_state =EXP_STATE )               !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_east_h_tim=cpl1_east_h_tim+(timef()-btim0)
!
!-------------------
!***  East V Points
!-------------------
!
      btim0=timef()
!
      NP_V=NUM_PARENT_TASKS_SENDING_V%EAST                                 !<-- # of parent tasks sending east boundary V data
!
      IF(NP_V>0)THEN
        NTAG=NTIMESTEP+108+ID_ADD                                          !<-- Add 108 and domain ID to obtain a unique east V tag
!
        DO N=1,NP_V                                                        !<-- Loop over each parent task sending Eboundary V data
          btim=timef()
          CALL MPI_RECV(PARENT_TASK(N)%EAST_V%STRING                    &  !<-- 1-D boundary datastring from parent task
                       ,PARENT_TASK(N)%EAST_V%LENGTH                    &  !<-- # of words in the datastring
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,PARENT_TASK(N)%EAST_V%ID_SOURCE                 &  !<-- Local rank of the parent task sending the datastring
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
          cpl1_recv_tim=cpl1_recv_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!
          CALL CHILD_DATA_FROM_STRING(length_data  =PARENT_TASK(N)%EAST_V%LENGTH     &
                                     ,datastring   =PARENT_TASK(N)%EAST_V%STRING     & 
                                     ,ilim_lo      =1                                &
                                     ,ilim_hi      =N_BLEND_V                        &
                                     ,jlim_lo      =INDX_MIN_V%EAST                  &
                                     ,jlim_hi      =INDX_MAX_V%EAST                  &
                                     ,i_start      =1                                &
                                     ,i_end        =N_BLEND_V                        &
                                     ,j_start      =PARENT_TASK(N)%EAST_V%INDX_START &
                                     ,j_end        =PARENT_TASK(N)%EAST_V%INDX_END   &
                                     ,nvars_bc_2d_h=NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                     ,nvars_bc_3d_h=NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                     ,nvars_bc_4d_h=NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                     ,lbnd_4d      =LBND_4D                          &  !<-- Lower bounds of 4-D variables' 4th dimension
                                     ,ubnd_4d      =UBND_4D                          &  !<-- Upper bounds of 4-D variables' 4th dimension
                                     ,nvars_bc_2d_v=NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                     ,nvars_bc_3d_v=NVARS_BC_3D_V                    &  !<-- # of 3-D V-pt vbls on child boundary
                                     ,bc_vars_v    =MY_BC_VARS_V_E )                    !<-- Child's 1-D segment of V-pt vbls on Ebndry
!
        ENDDO
!
!-----------------------------------------------------------------------
!
        CALL EXPORT_CHILD_BOUNDARY(nvars_bc_2d_h=NVARS_BC_2D_H          &  !<-- # of 2-D H-pt vbls on child boundary
                                  ,nvars_bc_3d_h=NVARS_BC_3D_H          &  !<-- # of 3-D H-pt vbls on child boundary
                                  ,nvars_bc_4d_h=NVARS_BC_4D_H          &  !<-- # of 4-D H-pt vbls on child boundary
                                  ,lbnd_4d      =LBND_4D                &  !<-- Lower bounds of 4-D variables' 4th dimension
                                  ,ubnd_4d      =UBND_4D                &  !<-- Upper bounds of 4-D variables' 4th dimension
                                  ,nvars_bc_2d_v=NVARS_BC_2D_V          &  !<-- # of 2-D V-pt vbls on child boundary
                                  ,nvars_bc_3d_v=NVARS_BC_3D_V          &  !<-- # of 3-D V-pt vbls on child boundary
                                  ,bc_vars_v     =MY_BC_VARS_V_E        &  !<-- Child's 1-D segment of V-pt vbls on Ebndry
                                  ,ilim_lo       =1                     &  !<-- Lower I limit of child's segment of boundary
                                  ,ilim_hi       =N_BLEND_V             &  !<-- Upper I limit of child's segment of boundary
                                  ,jlim_lo       =INDX_MIN_V%EAST       &  !<-- Lower J limit of child's segment of boundary
                                  ,jlim_hi       =INDX_MAX_V%EAST       &  !<-- Upper J limit of child's segment of boundary
                                  ,data_name     ='EAST_V_'//TIME_FLAG  &  !<-- Name attached to the combined exported data
                                  ,data_exp      =BOUND_1D_EAST_V       &  !<-- Combined boundary segment V data for child task
                                  ,export_state  =EXP_STATE )              !<-- The Parent-Child Coupler export state
!
      ENDIF
!
      cpl1_east_v_tim=cpl1_east_v_tim+(timef()-btim0)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Clocktime for Recv in Phase1 into Cpl Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='Cpl1_Recv_Time'                     &  !<-- Name of the attribute to insert
                            ,value=cpl1_recv_tim                        &  !<-- Phase 1 Recv time
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE NEST_RECVS_BC_DATA
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHILDREN_RECV_PARENT_DATA
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENTS_SEND_CHILD_DATA(CPL_COMP                       &
                                        ,IMP_STATE                      &
                                        ,EXP_STATE                      &
                                        ,CLOCK                          &
                                        ,RC_FINAL)
!
!-----------------------------------------------------------------------
!***  Parents send new boundary data to each of their children.
!***  Only parents execute this routine that is called as phase 4
!***  of the Run step of the Parent-Child coupler in subroutine
!***  NMM_INTEGRATE.
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The NMM Clock for this parent domain
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: CHILDTASK_0                                 &
                           ,COMM_FCST_TASKS                             &
                           ,I_PARENT_SW_OLD                             &
                           ,J_PARENT_SW_OLD                             &
                           ,KOUNT_MOVING,MY_DOMAIN_ID,N,N_MOVING        &
                           ,N_UPDATE_CHILD_TASKS                        &
                           ,NR,NRES,NTAG0                               &
                           ,NTIMESTEP                                   &
                           ,NTIMESTEP_CHILD                             &
                           ,NTIMESTEP_MOVE                              &
                           ,NUM_CHILD_TASKS,SPACE_RATIO
!
      INTEGER(kind=KINT) :: IERR,IRTN,RC,RC_CPL_RUN
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER(kind=KINT),DIMENSION(:),ALLOCATABLE,SAVE ::               &
                                                  PROCEED_AFTER_BC_RECV
!
      INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: CHILD_TASK_LIMITS
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      LOGICAL(kind=KLOG) :: EXCH_DONE                                   &
                           ,INTEGRATE_TIMESTEP,PARENT_MOVED             &
                           ,SHIFT_INFO_IS_PRESENT
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      btim0=timef()
      btim2=timef()
!
!-----------------------------------------------------------------------
!***  Initialize the error signal variables.
!-----------------------------------------------------------------------
!
      RC        =ESMF_SUCCESS
      RC_FINAL  =ESMF_SUCCESS
      RC_CPL_RUN=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!
!-----------------------
!***  Current Domain ID
!-----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PARENTS_SEND_CHILD_DATA: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------
!***  Are we in the free forecast?
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PARENTS_SEND_CHILD_DATA: Extract Free Forecast flag"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Free Forecast'                      &  !<-- Name of the attribute to extract
                            ,value=FREE_FORECAST                        &  !<-- Is this the free forecast?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      DIG_FILTER=.FALSE.
      IF(.NOT.FREE_FORECAST)THEN
        DIG_FILTER=.TRUE.
      ENDIF     
!
!-----------------------------------------------------------------------
!***  Point to the correct part of the composite object which will
!***  align working variables with values associated with this domain.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Intracommunicator for current domain's forecast tasks
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Fcst Task Intracommunicator"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Current domain's intracomm for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_CLOCKGET(CLOCK       =CLOCK                             &  !<-- The ESMF Clock
                        ,advanceCount=ntimestep_esmf                    &  !<-- The parent's current timestep (ESMF)
                        ,rc          =rc)
!
      NTIMESTEP=NTIMESTEP_ESMF                                             !<-- The parent just finished the current timestep
!
!-----------------------------------------------------------------------
!
      CHILDTASK_0=FTASKS_DOMAIN(MY_DOMAIN_ID)                              !<-- Rank of each child's task 0 in intracommunicator
      KOUNT_MOVING=0                                                       !<-- Keep track of nests who want to move.
!
!-----------------------------------------------------------------------
!***  The following block is for the setup in which this parent domain
!***  is a moving nest and it contains children (which must be moving
!***  and cannot be static).
!***  If this domain is going to move in one of its parent's timesteps
!***  from now (TIME_RATIO_MY_PARENT timesteps of this domain) then
!***  it now notifies its children of the coming shift.  This is
!***  required so that the children will be able to recompute the
!***  parent-child task layout relationships which will change when the
!***  parent moves.  This will force the children to wait to recv the
!***  task update specifications for BCs from the parent before they
!***  execute their normal recvs of BC data updates from the future
!***  at the end of this routine.
!***  If the parent just moved at the beginning of the current timestep
!***  it must adjust its location of its children.
!***  Note that I_SHIFT_CHILD and J_SHIFT_CHILD here are the shift
!***  values of this parent domain on its own grid inherited from
!***  subroutine CHILDREN_RECV_PARENT_DATA in which it was a child.
!-----------------------------------------------------------------------
!
      PARENT_MOVED=.FALSE.
!
      parent_moves: IF(MY_DOMAIN_MOVES)THEN                                !<-- Does this parent domain move?
!
!-----------------------------------------------------------------------
!***  The lead task on this parent domain notifies the lead tasks on
!***  each of its children's domains that it is going to shift.
!***  Even though PARENT_SHIFT is the same for all children it must
!***  be filled after the call to MPI_WAIT.
!-----------------------------------------------------------------------
!
        btim2=timef()
!
        IF(NTIMESTEP==NEXT_MOVE_TIMESTEP-TIME_RATIO_MY_PARENT*LAG_STEPS)THEN  !<-- Parent sends its shift information at the end of the
!                                                                             !    timestep in which the decision to shift was made.
          IF(NUM_CHILDREN>0.AND.I_AM_LEAD_FCST_TASK)THEN
!
            DO N=1,NUM_CHILDREN
!
              CALL MPI_WAIT(HANDLE_PARENT_SHIFT(N)                      &  !<-- Handle for ISend of parent's shift
                           ,JSTAT                                       &  !<-- MPI status
                           ,IERR)
!
              PARENT_SHIFT(1)=NEXT_MOVE_TIMESTEP                           !<-- Parent will shift in this parent timestep.
              PARENT_SHIFT(2)=I_SHIFT_CHILD                                !<-- Parent's I shift in its space
              PARENT_SHIFT(3)=J_SHIFT_CHILD                                !<-- Parent's J shift in its space
!
              NTAG0=PARENT_SHIFT_TAG+NTIMESTEP+1                           !<-- Unique MPI tag valid 1 parent timestep after decision to shift
              CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(0)    !<-- Local rank of child N's lead task in parent-child intracomm
!
              CALL MPI_ISSEND(PARENT_SHIFT                              &  !<-- Send parent's shift to all its children
                             ,3                                         &  !<-- There are 2 words in the message
                             ,MPI_INTEGER                               &  !<-- The shift increments are integers
                             ,CHILDTASK_0                               &  !<-- Signal sent to all lead child tasks
                             ,NTAG0                                     &  !<-- Tag valid for parent timestep preceding its actual shift
                             ,COMM_TO_MY_CHILDREN(N)                    &  !<-- MPI communicator between this parent and its children
                             ,HANDLE_PARENT_SHIFT(N)                    &  !<-- Communication request handle for this ISend to children
                             ,IERR )
!
            ENDDO
!
            pscd1_tim=pscd1_tim+(timef()-btim2)
!
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!
        this_timestep: IF(NTIMESTEP==NEXT_MOVE_TIMESTEP)THEN
!
          btim2=timef()
!
          PARENT_MOVED=.TRUE.                                              !<-- Parent moved at beginning of current timestep
!
          DO N=1,NUM_CHILDREN
            I_PARENT_SW(N)=I_PARENT_SW(N)-I_SHIFT_CHILD                    !<-- Child N's new SW corner I after parent moved
            J_PARENT_SW(N)=J_PARENT_SW(N)-J_SHIFT_CHILD                    !<-- Child N's new SW corner J after parent moved
          ENDDO
!
!-----------------------------------------------------------------------
!***  Now fill the parent's data objects that hold the nest-resolution
!***  topography at child H points and child V points.  Since the
!***  parent just moved then its MPI task subdomains need that data
!***  for their new locations.  Note that in this situation the total
!***  number of children must equal the number of moving children.
!-----------------------------------------------------------------------
!
          CALL PARENT_READS_MOVING_CHILD_TOPO(MY_DOMAIN_ID              &
                                             ,NUM_CHILDREN              &
                                             ,LINK_MRANK_RATIO          &
                                             ,LIST_OF_RATIOS            &
                                             ,M_NEST_RATIO              &
                                             ,NUM_SPACE_RATIOS_MVG      &
                                             ,GLOBAL_TOP_PARENT         &
                                             ,IM_1,JM_1                 &
                                             ,TPH0_1,TLM0_1             &
                                             ,SB_1,WB_1                 &
                                             ,RECIP_DPH_1,RECIP_DLM_1   &
                                             ,GLAT,GLON                 &
                                             ,NEST_FIS_ON_PARENT_BNDS   &
                                             ,NEST_FIS_ON_PARENT        &
                                             ,NEST_FIS_V_ON_PARENT      &
                                             ,IDS,IDE,IMS,IME,ITS,ITE   &
                                             ,JDS,JDE,JMS,JME,JTS,JTE)
!
          read_moving_child_topo_tim=read_moving_child_topo_tim+(timef()-btim2)
!
        ENDIF  this_timestep
!
      ENDIF  parent_moves
!
!-----------------------------------------------------------------------
!***  The parent generates new boundary data for all of its children
!***  given their domains' positions at the beginning of this parent
!***  timestep and sends it to the children so they can form time
!***  tendencies for their boundary variables as they integrate through
!***  this parent timestep.  This is relevant for all children, both
!***  static and moving.  If this is now a timestep in which the
!***  child shifts then the parent must now reset those working
!***  pointers/arrays that are used for the preparation of the
!***  standard child boundary updates that are sent back in time
!***  to all children every parent timestep so the child can generate
!***  its boundary tendencies.  The reset is needed because the child's
!***  boundary has different associations with the parent tasks after
!***  the move.  The same work is needed if the parent domain moved
!***  at the beginning of this timestep since that also changes the
!***  association of parent tasks and child boundary tasks.  Also if
!***  the child just moved then the parent should update its haloes
!***  for those variables used to update the child's boundaries
!***  because a parent task's halo points will need to be used if 
!***  some of the child's boundary rows lie within the parent task's
!***  integration points while others lie within that parent task's
!***  halo points.
!-----------------------------------------------------------------------
!
      btim2=timef()
!
      DO N=1,NUM_CHILDREN
!
        IF(STATIC_OR_MOVING(N)=='Moving')THEN                              !<-- Select the children who can move.
          KOUNT_MOVING=KOUNT_MOVING+1
!
          IF(NTIMESTEP==NTIMESTEP_CHILD_MOVES(N)                        &  !<-- If either of these statements is true
                     .OR.                                               &  !    then child N just moved relative
             PARENT_MOVED)THEN                                             !    to this parent.
!
            NRES=LINK_MRANK_RATIO(KOUNT_MOVING)                            !<-- Rank of space ratio value among the moving children
!
            CALL RESET_WORK_PARENT(N,NRES,'Future',PARENT_MOVED)           !<-- Reset working arrays for this moving nest.
!
          ENDIF
!
        ENDIF
!
        IF(FREE_FORECAST.OR.(DIG_FILTER.AND.CHILD_ACTIVE(N)))THEN          !<-- For DFI, check that the child is participating.
!
          CALL COMPUTE_SEND_NEST_BC_DATA(N,'Future')                       !<-- Parent sends BC data to children from their future.
!
        ENDIF
!
      ENDDO
!
      IF(PARENT_MOVED)PARENT_MOVED=.FALSE.
!
      pscd2_tim=pscd2_tim + (timef()-btim2)
!
!-----------------------------------------------------------------------
!***  We are at the end of a parent timestep.  If the parent has
!***  children who move then:
!***
!***  (1) The parent receives a message from each child who can move
!***      only when the child wants to move.  The message contains
!***      the parent timestep in which the child will shift as well
!***      as the shift in I and J on the parent grid.  The message
!***      is received by the parent at the end of a parent timestep
!***      while the child will have sent it from the beginning of
!***      an earlier parent timestep depending on the relative
!***      integration speeds of parent and child.
!***  (2) The parent computes and sends new information to the moving
!***      children regarding the association of parent and child tasks
!***      for the children's new locations after they move.  Then the
!***      parent computes and sends the new internal child data for
!***      those child gridpoints that have moved over a new region of
!***      the parent grid as well as the new starting boundary data
!***      for their grids' new locations.
!-----------------------------------------------------------------------
!
      moving_children: IF(NUM_MOVING_CHILDREN>0)THEN                       !<-- Select all of this parent's moving children
!
!-----------------------------------------------------------------------
!
        btim2=timef()
!
        CALL MPI_BARRIER(COMM_FCST_TASKS,IRTN)                             !<-- Syncs Probe below with BC ISends above; required
!
        barrier_move_tim=barrier_move_tim+(timef()-btim2)
!
        EXCH_DONE=.FALSE.                                                  !<-- Initialize flag for parent halo exchanges
!
!-----------------------------------------------------------------------
!
        btim2=timef()
!
        parent_task_0: IF(I_AM_LEAD_FCST_TASK)THEN                         !<-- Lead parent task will probe for children's shift signals.
!
!-----------------------------------------------------------------------
!
          child_loop_1: DO N=1,NUM_MOVING_CHILDREN                         !<-- Loop through this parent's moving children.
!
!-----------------------------------------------------------------------
!
            N_MOVING=RANK_MOVING_CHILD(N)                                  !<-- In the list of this parent's children, these can move.
!
!-----------------------------------------------------------------------
!
            check_block1: IF(NTIMESTEP>NTIMESTEP_CHILD_MOVES(N))THEN       !<-- Probe only after child's previous shift is complete.
!
!-----------------------------------------------------------------------
!
              MOVE_FLAG(N)=.FALSE.                                         !<-- True only when parent first learns child N wants to move.
!
              CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N_MOVING)%DATA(0) !<-- Local rank of child's lead task in p-c intracommunicator
              MOVE_TAG=1111+10*MY_CHILDREN_ID(N_MOVING)                 &  !<-- Unique MPI tag uses child and parent domain IDs
                           +25*MY_DOMAIN_ID
!
              CALL MPI_IPROBE(CHILDTASK_0                               &  !<-- Is shift info present from moving child N's fcst task 0?
                             ,MOVE_TAG                                  &  !<-- Tag associated with nest N's move flag
                             ,COMM_TO_MY_CHILDREN(N_MOVING)             &  !<-- MPI communicator between parent and moving child N
                             ,SHIFT_INFO_IS_PRESENT                     &  !<-- Is the nest's shift information now available?
                             ,JSTAT                                     &
                             ,IERR)
!
!-----------------------------------------------------------------------
!
              IF(SHIFT_INFO_IS_PRESENT)THEN
!
                MOVE_FLAG(N)=.TRUE.                                        !<-- Moving child N is saying it wants to move
!
                CALL MPI_RECV(SHIFT_INFO_CHILDREN(1,N)                  &  !<-- Recv the message and clear the nest's ISEND 
                             ,4                                         &  !<-- # of words in message
                             ,MPI_INTEGER                               &  !<-- The message is type Integer.
                             ,CHILDTASK_0                               &  !<-- The message was sent by moving child N's fcst task 0.
                             ,MOVE_TAG                                  &  !<-- Arbitrary tag used for this data exchange
                             ,COMM_TO_MY_CHILDREN(N_MOVING)             &  !<-- MPI communicator between parent and moving child N
                             ,JSTAT                                     &
                             ,IERR)
!
                IF(I_WANT_TO_MOVE.AND.MOVE_FLAG(N))THEN
                  MOVE_FLAG(N)=.FALSE.                                     !<-- Turn off the child's shift if parent also wants to move.
                ENDIF
!
                IF(NTIMESTEP>=NTIMESTEP_FINAL-2)THEN   
                  MOVE_FLAG(N)=.FALSE.                                     !<--  Children must not move just before the fcst ends
                ENDIF
!
              ENDIF
!
!-----------------------------------------------------------------------
!
            ENDIF check_block1   
!
!-----------------------------------------------------------------------
!
          ENDDO child_loop_1
!
!-----------------------------------------------------------------------
!
        ENDIF parent_task_0
!
        t0_recv_move_tim=t0_recv_move_tim+(timef()-btim2)
!
!-----------------------------------------------------------------------
!
        child_loop_2: DO N=1,NUM_MOVING_CHILDREN                           !<-- Loop through this parent's moving children
!
          N_MOVING=RANK_MOVING_CHILD(N)                                    !<-- In the list of this parent's children, these can move.
!
!-----------------------------------------------------------------------
!***  Parent task 0 informs the other parent tasks if moving child N 
!***  has signaled that it wants to move and if so then it shares
!***  the child's shift information.  The 3 words in the shift info are:
!     (1) The parent's timestep in which child N will move.
!     (2) The child's shift in I on the parent grid.
!     (3) The child's shift in J on the parent grid.
!-----------------------------------------------------------------------
!
          check_block2: IF(NTIMESTEP>NTIMESTEP_CHILD_MOVES(N))THEN
!
!-----------------------------------------------------------------------
!
            btim2=timef()
!
            CALL MPI_BCAST(MOVE_FLAG(N)                                 &  !<-- Moving child N's signal:  Does it want to move?
                          ,1                                            &  !<-- The timestep is one word
                          ,MPI_LOGICAL                                  &  !<-- The signal is type Logical
                          ,0                                            &  !<-- Broadcast from parent forecast task 0
                          ,COMM_FCST_TASKS                              &  !<-- Intracommunicator for this parent's forecast tasks
                          ,IRTN )
!
            IF(MOVE_FLAG(N))THEN                                           !<-- If true then moving child N sent shift information.
!
              CALL MPI_BCAST(SHIFT_INFO_CHILDREN(1,N)                   &  !<-- Moving child N's shift information
                            ,4                                          &  !<-- # of words in message
                            ,MPI_INTEGER                                &  !<-- The message is type Integer
                            ,0                                          &  !<-- Broadcast from parent forecast task 0
                            ,COMM_FCST_TASKS                            &  !<-- Intracommunicator for this parent's forecast tasks
                            ,IRTN )
!
              IF(SHIFT_INFO_CHILDREN(1,N)>0)THEN
                NTIMESTEP_CHILD_MOVES(N)=SHIFT_INFO_CHILDREN(1,N)          !<-- The parent timestep in which the child will move
!
              ELSEIF(SHIFT_INFO_CHILDREN(1,N)==-11111)THEN                 !<-- Child is forcing the parent to move.
                IF(.NOT.I_WANT_TO_MOVE)THEN                                !<-- Parent already wants to shift so do not force it again.
                  CHILD_FORCES_MY_SHIFT=.TRUE.                             !<-- Child N too close to parent boundary
                  MY_FORCED_SHIFT(1)=SHIFT_INFO_CHILDREN(2,N)              !<-- Parent must shift this many gridspaces in I
                  MY_FORCED_SHIFT(2)=SHIFT_INFO_CHILDREN(3,N)              !<-- Parent must shift this many gridspaces in J
!
                  IF(I_AM_LEAD_FCST_TASK)THEN
                    WRITE(0,74741)MY_FORCED_SHIFT,MY_DOMAIN_ID,NTIMESTEP
74741               FORMAT(' PARENTS_SEND my_forced_shift=',2(1X,I6),' my_domain_id=',I2,' ntimestep=',I5)
                  ENDIF
!
                ENDIF
!
              ENDIF
!
            ENDIF
!
            pscd3_tim=pscd3_tim+(timef()-btim2)
!
!-----------------------------------------------------------------------
!
          ENDIF check_block2
!
!-----------------------------------------------------------------------
!***  If the parent is at the end of a timestep immediately preceding
!***  a child's shift at the start of the next parent timestep then
!***  it prepares appropriate internal and BC update data for the
!***  child's new position.
!-----------------------------------------------------------------------
!
          child_moves: IF(NTIMESTEP==NTIMESTEP_CHILD_MOVES(N)-1)THEN       !<-- If true, moving child N will shift at the 
!                                                                          !    beginning of the next parent timestep.
!-----------------------------------------------------------------------
!
            btim2=timef()
!
            I_PARENT_SW_OLD=I_PARENT_SW(N_MOVING)                          !<-- Save the previous location of the nest.
            J_PARENT_SW_OLD=J_PARENT_SW(N_MOVING)                          !<--
!
            CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N_MOVING)%DATA(0) !<-- Local rank of child's lead task in p-c intracomm
!
            I_PARENT_SW(N_MOVING)=I_PARENT_SW_OLD+SHIFT_INFO_CHILDREN(2,N)   !<-- Child N to move its SW corner to this parent I
            J_PARENT_SW(N_MOVING)=J_PARENT_SW_OLD+SHIFT_INFO_CHILDREN(3,N)   !<-- Child N to move its SW corner to this parent J
!
!-----------------------------------------------------------------------
!***  If this child will shift at the start of the next parent timestep
!***  then reset the working arrays/pointers used to generate values
!***  interpolated from the  parent to child's boundary immediately
!***  after a move.  This set of working objects is separate from the
!***  standard ones used to interpolate boundary data for all nests 
!***  since when a nest moves we need to have the objects in place
!***  for both the old location and the new until we know for certain
!***  those for the old location have been received by the moving child.
!
!***  Note that N_MOVING is the rank of the moving child among ALL of
!***  children and NRES is the rank of the moving child's space ratio
!***  in the list of unique space ratios for all moving children.
!-----------------------------------------------------------------------
!
            NRES=LINK_MRANK_RATIO(N)                                       !<-- Rank of space ratio value among the moving children
!
            CALL RESET_WORK_PARENT(N_MOVING,NRES,'Current',PARENT_MOVED)
!
!-----------------------------------------------------------------------
!***  The parent generates and sends new boundary data for the child's 
!***  new position that it will move to when it reaches this point in
!***  time that the parent is at now.
!-----------------------------------------------------------------------
!
            CALL COMPUTE_SEND_NEST_BC_DATA(N_MOVING,'Current')
!
!-----------------------------------------------------------------------
!***  Parent tasks determine the index limits of the regions on
!***  moving nest N's task subdomains that they are responsible
!***  for updating after the nest moves.  Those index limits are
!***  identical for H and V points.
!-----------------------------------------------------------------------
!
            CHILD_TASK_LIMITS=>CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N_MOVING)%DATA
            NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N_MOVING))
            SPACE_RATIO=PARENT_CHILD_SPACE_RATIO(N_MOVING)
!
            N_UPDATE_CHILD_TASKS=0
            pscd4_tim=pscd4_tim+(timef()-btim2)
!
            btim2=timef()
            CALL PARENT_BOOKKEEPING_MOVING(I_PARENT_SW(N_MOVING)        &  !<-- SW corner of nest is on this parent I after move
                                          ,J_PARENT_SW(N_MOVING)        &  !<-- SW corner of nest is on this parent J after move
                                          ,I_PARENT_SW_OLD              &  !<-- SW corner of nest is on this parent I before move
                                          ,J_PARENT_SW_OLD              &  !<-- SW corner of nest is on this parent J before move
                                          ,ITS,ITE,JTS,JTE              &  !<-- ITS,ITE,JTS,JTE for this parent task
                                          ,NUM_CHILD_TASKS              &  !<-- # of child forecast tasks
                                          ,CHILD_TASK_LIMITS            &  !<-- ITS,ITE,JTS,JTE for each child forecast task
                                          ,SPACE_RATIO                  &  !<-- # of child grid increments in one of parent's
                                          ,NHALO                        &  !<-- # of halo points
                                          ,NROWS_P_UPD_W                &  !<-- Moving nest footprint W bndry rows updated by parent
                                          ,NROWS_P_UPD_E                &  !<-- Moving nest footprint E bndry rows updated by parent
                                          ,NROWS_P_UPD_S                &  !<-- Moving nest footprint S bndry rows updated by parent
                                          ,NROWS_P_UPD_N                &  !<-- Moving nest footprint N bndry rows updated by parent
                                          ,N_UPDATE_CHILD_TASKS         &  !<-- # of moving nest tasks updated by this parent task
                                          ,TASK_UPDATE_SPECS(N)         &  !<-- Linked list of nest task update region specs
                                          ,HANDLE_MOVE_DATA(N)%NTASKS_TO_RECV &  !<-- MPI handles for update data ISent to nest N's tasks
                                          ,MOVING_CHILD_UPDATE(N)       &  !<-- Composite H/V update data for tasks on moving child N
                                            )
!
!-----------------------------------------------------------------------
!***  When a parent needs to update data on some of its moving nests
!***  and any of those nest points lie between ITE/JTE on one parent
!***  task and ITS/JTS on an adjacent parent task then values from 
!***  the parent tasks' halo regions must be used.  However some of
!***  the variables that need updating are not computed in the halo
!***  regions.  That means that prior to proceeding with moving nest
!***  updates the parent needs to do special halo exchanges for all
!***  those variables required for moving nest updates but for which
!***  halo exchanges were not performed during the normal integration.
!***  Of course these parent tasks' halo exchanges need to be done
!***  only once in a timestep in which any number of its nests move. 
!-----------------------------------------------------------------------
!
            IF(.NOT.EXCH_DONE)THEN
!
              CALL PARENT_UPDATES_HALOS('H'                               &
                                        ,MOVE_BUNDLE_H                    &
                                        ,NUM_FIELDS_MOVE_3D_H             &
                                        ,NUM_FIELDS_MOVE_2D_H_R           &
                                        ,nflds_2di=NUM_FIELDS_MOVE_2D_H_I)
!
              CALL PARENT_UPDATES_HALOS('V'                             &
                                        ,MOVE_BUNDLE_V                  &
                                        ,NUM_FIELDS_MOVE_3D_V           &
                                        ,NUM_FIELDS_MOVE_2D_V )
!
              EXCH_DONE=.TRUE.
!
            ENDIF
!
     parent_bookkeep_moving_tim=parent_bookkeep_moving_tim+(timef()-btim2)
!
!-----------------------------------------------------------------------
!***  While the index limits of each parent update region of each 
!***  moving nest are identical for H and V points the routine that
!***  performs the updating will be called separately for H and V
!***  points.  That is because of the different physical locations
!***  of H versus V points which must be accounted for when finding 
!***  the parent's four surrounding points for bilinear interpolations.
!-----------------------------------------------------------------------
!
            btim2=timef()
!
            IF(N_UPDATE_CHILD_TASKS>0)THEN
!
!-----------------------------------------------------------------------
!***  First do the H point updates for moving nest N.
!-----------------------------------------------------------------------
!
              NR=M_NEST_RATIO(N)                                           !<-- Child's space ratio with uppermost parent.
              NTIMESTEP_CHILD=(NTIMESTEP+1)                             &  !<-- The nest's timestep in which it will recv 
                              *TIME_RATIO_MY_CHILDREN(N_MOVING)            !    parent shift data.
!
              CALL PARENT_UPDATES_MOVING('H'                                 &
                                        ,N_UPDATE_CHILD_TASKS                &
                                        ,SPACE_RATIO                         &
                                        ,TIME_RATIO_MY_CHILDREN(N_MOVING)    &
                                        ,NTIMESTEP_CHILD                     &
                                        ,I_PARENT_SW(N_MOVING)               &
                                        ,J_PARENT_SW(N_MOVING)               &
                                        ,PT,PDTOP,PSGML1,SGML2,SG1,SG2       &
                                        ,DSG2,PDSG1                          &
                                        ,FIS,PD                              &
                                        ,T                                   &
                                        ,TRACERS(:,:,:,INDX_Q)               &
                                        ,TRACERS(:,:,:,INDX_CW)              &
                                        ,FTASKS_DOMAIN(MY_DOMAIN_ID)         &  !<-- # of forecast tasks on parent
                                        ,NUM_CHILD_TASKS                     &  !<-- # of child forecast tasks
                                ,child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA  &  !<-- Child task local ranks in p-c intracomm
                                        ,CHILD_TASK_LIMITS                   &  !<-- ITS,ITE,JTS,JTE for each child forecast task
                                        ,HYPER_A                             &  !<-- Underground extrapolation quantity 
                                        ,IMS,IME,JMS,JME                     &  !<-- Subdomain memory limits for parent tasks
                                        ,IDS,IDE,JDS,JDE                     &  !<-- Full parent domain limits
                                        ,LM                                  &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%LBND1 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%UBND1 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%LBND2 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%UBND2 &
                                        ,NEST_FIS_ON_PARENT(NRES)%DATA       &
                                        ,COMM_TO_MY_CHILDREN(N)              &
                                        ,HANDLE_MOVE_DATA(N)%NTASKS_TO_RECV  &
                                        ,MOVE_BUNDLE_H                       &
                                        ,NUM_FIELDS_MOVE_2D_H_I              &
                                        ,NUM_FIELDS_MOVE_2D_X_I              &
                                        ,NUM_FIELDS_MOVE_2D_H_R              &
                                        ,NUM_FIELDS_MOVE_2D_X_R              &
                                        ,NUM_FIELDS_MOVE_3D_H                &
                                        ,NUM_LEVELS_MOVE_3D_H                &
                                        ,NUM_FIELDS_MOVE_2D_V                &
                                        ,NUM_FIELDS_MOVE_3D_V                &
                                        ,NUM_LEVELS_MOVE_3D_V                &
                                        ,TASK_UPDATE_SPECS(N)                &  !<-- Linked list of nest task update region specs 
                                        ,MOVING_CHILD_UPDATE(N)              &  !<-- Composite H/V update data for nest task N
                                          )
!
!-----------------------------------------------------------------------
!***  Now the parent does the V point updates for moving nest N
!***  and then sends all H and V update data to that nest.
!-----------------------------------------------------------------------
!
              NR=M_NEST_RATIO(N)
!
              CALL PARENT_UPDATES_MOVING('V'                                 &
                                        ,N_UPDATE_CHILD_TASKS                &
                                        ,SPACE_RATIO                         &
                                        ,TIME_RATIO_MY_CHILDREN(N_MOVING)    &
                                        ,NTIMESTEP_CHILD                     &
                                        ,I_PARENT_SW(N_MOVING)               &
                                        ,J_PARENT_SW(N_MOVING)               &
                                        ,PT,PDTOP,PSGML1,SGML2,SG1,SG2       &
                                        ,DSG2,PDSG1                          &
                                        ,FIS,PD                              &
                                        ,T                                   &
                                        ,TRACERS(:,:,:,INDX_Q)               &
                                        ,TRACERS(:,:,:,INDX_CW)              &
                                        ,FTASKS_DOMAIN(MY_DOMAIN_ID)         &  !<-- # of forecast tasks on parent
                                        ,NUM_CHILD_TASKS                     &  !<-- # of child forecast tasks
                                ,child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA  &  !<-- Child task local ranks in p-c intracomm
                                        ,CHILD_TASK_LIMITS                   &  !<-- ITS,ITE,JTS,JTE for each child forecast task
                                        ,HYPER_A                             &  !<-- Underground extrapolation quantity 
                                        ,IMS,IME,JMS,JME                     &  !<-- Subdomain memory limits for parent tasks
                                        ,IDS,IDE,JDS,JDE                     &  !<-- Full parent domain limits
                                        ,LM                                  &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%LBND1 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%UBND1 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%LBND2 &
                                        ,NEST_FIS_ON_PARENT_BNDS(NRES)%UBND2 &
                                        ,NEST_FIS_V_ON_PARENT(NRES)%DATA     &
                                        ,COMM_TO_MY_CHILDREN(N)              &
                                        ,HANDLE_MOVE_DATA(N)%NTASKS_TO_RECV  &
                                        ,MOVE_BUNDLE_V                       &
                                        ,NUM_FIELDS_MOVE_2D_H_I              &
                                        ,NUM_FIELDS_MOVE_2D_X_I              &
                                        ,NUM_FIELDS_MOVE_2D_H_R              &
                                        ,NUM_FIELDS_MOVE_2D_X_R              &
                                        ,NUM_FIELDS_MOVE_3D_H                &
                                        ,NUM_LEVELS_MOVE_3D_H                &
                                        ,NUM_FIELDS_MOVE_2D_V                &
                                        ,NUM_FIELDS_MOVE_3D_V                &
                                        ,NUM_LEVELS_MOVE_3D_V                &
                                        ,TASK_UPDATE_SPECS(N)                &  !<-- Linked list of nest task update region specs
                                        ,MOVING_CHILD_UPDATE(N)              &  !<-- Composite H/V update data for nest task N
                                          )
            ENDIF
!
            parent_update_moving_tim=parent_update_moving_tim           &
                                    +(timef()-btim2)
!
!-----------------------------------------------------------------------
!***  If the child has executed its final shift before stopping due to
!***  its having reached the specified latitude limit then the parent
!***  sets its own flag to stop incorporating 2-way data from this
!***  child.
!-----------------------------------------------------------------------
!
            IF(SHIFT_INFO_CHILDREN(4,N)==-22222)THEN                       !<-- Child motion has stopped so skip 2-way updates.
              IF(NUM_2WAY_CHILDREN>0)THEN
                SKIP_2WAY_UPDATE(N_MOVING)=.TRUE.
              ENDIF
!
              IF(I_AM_LEAD_FCST_TASK)THEN
                WRITE(0,70110)N
70110           FORMAT(' Parent knows its moving child #',I2,' is now frozen.')
              ENDIF
            ENDIF
!
!-----------------------------------------------------------------------
!
          ENDIF child_moves
!
!-----------------------------------------------------------------------
!
        ENDDO child_loop_2
!
!-----------------------------------------------------------------------
!
      ENDIF moving_children
!
      btim2=timef()
!
!-----------------------------------------------------------------------
!***  The values of the moving children's next move timesteps need
!***  to be updated in the Solver's internal state so they can be 
!***  written to the restart file.  Dummy values are set for static
!***  children.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert the Children's Next Move Timesteps into Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =EXP_STATE                        &  !<-- The parent-child coupler export state
                            ,name     ='NEXT_TIMESTEP_CHILD_MOVES'      &  !<-- Name of the attribute to insert
                            ,itemCount=NUM_DOMAINS_MAX                  &  !<-- # of words in array
                            ,valueList=NTIMESTEP_CHILD_MOVES            &  !<-- The next timestep the moving children move
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Insert clocktimes into the coupler's export state that are related
!***  to this phase.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Clocktime for Comp in Phase2 into Cpl Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='Cpl2_Comp_Time'                     &  !<-- Name of the attribute to insert
                            ,value=cpl2_comp_tim                        &  !<-- Phase 2 Compute time
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Clocktime for Wait in Phase2 into Cpl Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='Cpl2_Wait_Time'                     &  !<-- Name of the attribute to insert
                            ,value=cpl2_wait_tim                        &  !<-- Phase 2 Wait time
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Clocktime for Send in Phase2 into Cpl Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='Cpl2_Send_Time'                     &  !<-- Name of the attribute to insert
                            ,value=cpl2_send_tim                        &  !<-- Phase 2 Send time
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='parent_bookkeep_moving_tim'         &  !<-- Name of the attribute to insert
                            ,value=parent_bookkeep_moving_tim           &  !<-- moving nest bookeeping time
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='parent_update_moving_tim'           &    !<-- Name of the attribute to insert
                            ,value=parent_update_moving_tim             &    !<-- moving nest update time
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='t0_recv_move_tim'                   &  !<-- Name of the attribute to insert
                            ,value=t0_recv_move_tim                     &  !<-- task 0 time to process receive of move flag
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='read_moving_child_topo_tim'         &  !<-- Name of the attribute to insert
                            ,value=read_moving_child_topo_tim           &  !<-- task 0 time to process receive of move flag
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                            ,name ='barrier_move_tim'                   &  !<-- Name of the attribute to insert
                            ,value=barrier_move_tim                     &  !<-- task 0 time to process receive of move flag
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                             ,name ='pscd_tim'                          &  !<-- Name of the attribute to insert
                             ,value=pscd_tim                            &  !<-- task 0 time to process receive of move flag
                             ,rc   =RC)
! 
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                             ,name ='pscd1_tim'                         &  !<-- Name of the attribute to insert
                             ,value=pscd1_tim                           &  !<-- task 0 time to process receive of move flag
                             ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                             ,name ='pscd2_tim'                         &  !<-- Name of the attribute to insert
                             ,value=pscd2_tim                            &  !<-- task 0 time to process receive of move flag
                             ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                             ,name ='pscd3_tim'                         &  !<-- Name of the attribute to insert
                             ,value=pscd3_tim                            &  !<-- task 0 time to process receive of move flag
                             ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=EXP_STATE                            &  !<-- The parent-child coupler export state
                             ,name ='pscd4_tim'                         &  !<-- Name of the attribute to insert
                             ,value=pscd4_tim                           &  !<-- task 0 time to process receive of move flag
                             ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_RUN)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      pscd_tim=pscd_tim+(timef()-btim0)
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!
      SUBROUTINE RESET_WORK_PARENT(N_CHILD,N_RATIO                      &
                                  ,TIME_FLAG,PARENT_MOVED)
!
!-----------------------------------------------------------------------
!***  A parent resets its working pointers/arrays that depend on a
!***  moving child's location to get ready to generate values on
!***  that child's boundary.  This routine is not called for static
!***  nests since there is nothing to reset for them.
!***  This is an internal subroutine to PARENTS_SEND_CHILD_DATA.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &  !<-- Rank of nest in list of ALL children
                                      ,N_RATIO                             !<-- Rank of space ratio value among the moving children
!
      CHARACTER(len=*),INTENT(IN) :: TIME_FLAG                             !<-- Child to recv data from its present or future
!
      LOGICAL(kind=KLOG),INTENT(IN) :: PARENT_MOVED                        !<-- Did this parent just shift its own domain?
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: IERR,INDX,N,NR,NT,NTAG,NUM_CHILD_TASKS
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  If this child wants to move then deallocate parent working 
!***  arrays/pointers whose dimensions are functions of moving nests' 
!***  positions.  They will be reallocated with dimensions appropriate
!***  for the new positions.  (For static nests these parent arrays 
!***  are used over and over and are not deallocated/reallocated.)
!***  If this is the first time we have reached this point though
!***  then nothing has been allocated yet so skip the deallocation.
!***  Note however that if this parent can move then it must call
!***  this routine when it shifts since that will also mean that
!***  its children's positions have changed with respect to the
!***  parent's grid.
!-----------------------------------------------------------------------
!
      INDX=1
      IF(TIME_FLAG=='Current')INDX=2
!
      CALL DEALLOC_WORK_PARENTS(N_CHILD,TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  We now compute various indices and weights needed by the parents
!***  to compute boundary data for their children.  It is here that
!***  location-dependent interpolation information is determined 
!***  regarding the parent and nests.  Parents need to call these
!***  routines only for children who have moved because this work was
!***  done once and for all for static nests in the coupler's Init
!***  step.
!-----------------------------------------------------------------------
!
      CALL PREPARE_NEST_INTERP_FACTORS(N_CHILD,MY_DOMAIN_ID)
!
      CALL POINT_INTERP_DATA_TO_MEMORY(N_CHILD,MY_DOMAIN_ID,TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  The parent determines the new association between its tasks
!***  and those of its moving child's then sends the information
!***  to that child so the child will know exactly how to receive
!***  the new internal and boundary data from its parent when the
!***  child arrives at this point in time and executes its move.
!***  This only needs to be done when the nest has just moved, i.e.,
!***  when the time flag has switched to 'Current'.  When it goes
!***  back to 'Future' we do not need to send the information again
!***  since the nest has not moved again and thus the associations
!***  remain the same.
!-----------------------------------------------------------------------
!
      IF(TIME_FLAG=='Current'.OR.PARENT_MOVED)THEN
!
        CALL PARENT_SENDS_CHILD_DATA_LIMITS(N_CHILD,MY_DOMAIN_ID,TIME_FLAG)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  The parent determines the child's boundary topography at the
!***  new location after the child moves.  This is needed to maintain
!***  hydrostatic balance when parent data is interpolated to child
!***  boundaries where the terrain is different.
!-----------------------------------------------------------------------
!
      NR=N_RATIO                 
!
      CALL PARENT_COMPUTES_CHILD_TOPO(N_CHILD                           &
                                     ,I_PARENT_SW(N_CHILD)              &
                                     ,J_PARENT_SW(N_CHILD)              &
                                     ,IM_CHILD(N_CHILD)                 &
                                     ,JM_CHILD(N_CHILD)                 &
                                     ,N_BLEND_H_CHILD(N_CHILD)          &
                                     ,NEST_FIS_ON_PARENT_BNDS(NR)%LBND1 &
                                     ,NEST_FIS_ON_PARENT_BNDS(NR)%UBND1 &
                                     ,NEST_FIS_ON_PARENT_BNDS(NR)%LBND2 &
                                     ,NEST_FIS_ON_PARENT_BNDS(NR)%UBND2 &
                                     ,NEST_FIS_ON_PARENT(NR)%DATA       &
                                       )
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE RESET_WORK_PARENT
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE COMPUTE_SEND_NEST_BC_DATA(N_CHILD,TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  A parent generates and sends boundary data to a child.
!***  This is an internal subroutine to PARENTS_SEND_CHILD_DATA.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                             !<-- Compute/send this child's boundary conditions
!
      CHARACTER(len=*),INTENT(IN) :: TIME_FLAG                             !<-- Child to recv data from its present or future
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: CHILDTASK,H_OR_V_INT,I,ID_ADD,IERR,INDX2,J  &
                           ,KOUNT_H,KOUNT_V                             &
                           ,LB1,LB2,LB_4D                               &
                           ,N,N4,NRANK,NT,NTAG                          &
                           ,NUM_CHILD_TASKS,NUM_DIMS,NUM_LEVS,NV        &
                           ,UB1,UB2,UB_4D
!
      INTEGER(kind=KINT) :: ISTAT
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME) :: PD_V
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: ARRAY_R2D
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: ARRAY_R3D             &
                                                 ,VBL_ARRAY
!
      REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: ARRAY_R4D
!
      CHARACTER(len=99) :: FIELD_NAME
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
! 
      N=N_CHILD                                                            !<-- The Nth child of this parent.
!
!-----------------------------------------------------------------------
!***  Select the appropriate part of the working array depending on
!***  whether we are now concerned with children's boundaries for
!***  their current time or from their future.
!-----------------------------------------------------------------------
!
      IF(TIME_FLAG=='Future')THEN
        INDX2=1
      ELSEIF(TIME_FLAG=='Current')THEN
        INDX2=2
      ENDIF
!
      KOUNT_H=0
      KOUNT_V=0
!
!-----------------------------------------------------------------------
!***  Before parents can generate new boundary data for their children
!***  we must check to be sure the previous set of ISend's from the
!***  parent tasks to the children's boundary tasks have completed.
!-----------------------------------------------------------------------
!
      btim=timef()
!
!-------------
!***  South H
!-------------
!
      IF(NUM_TASKS_SEND_H_S(N)>0)THEN                                      !<-- Parent task has Sbndry H data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_H_S(N)
          CALL MPI_WAIT(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!-------------
!***  South V
!-------------
!
      IF(NUM_TASKS_SEND_V_S(N)>0)THEN                                      !<-- Parent task has Sbndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_S(N)
          CALL MPI_WAIT(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!-------------
!***  North H
!-------------
!
      IF(NUM_TASKS_SEND_H_N(N)>0)THEN                                      !<-- Parent task has Nbndry H data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_H_N(N)
          CALL MPI_WAIT(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!-------------
!***  North V
!-------------
!
      IF(NUM_TASKS_SEND_V_N(N)>0)THEN                                      !<-- Parent task has Nbndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_N(N)
          CALL MPI_WAIT(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!------------
!***  West H
!------------
!
      IF(NUM_TASKS_SEND_H_W(N)>0)THEN                                      !<-- Parent task has Wbndry H data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_H_W(N)
          CALL MPI_WAIT(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!------------
!***  West V
!------------
!
      IF(NUM_TASKS_SEND_V_W(N)>0)THEN                                      !<-- Parent task has Wbndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_W(N)
          CALL MPI_WAIT(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!------------
!***  East H
!------------
!
      IF(NUM_TASKS_SEND_H_E(N)>0)THEN                                      !<-- Parent task has Ebndry H data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_H_E(N)
          CALL MPI_WAIT(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
!------------
!***  East V
!------------
!
      IF(NUM_TASKS_SEND_V_E(N)>0)THEN                                      !<-- Parent task has Ebndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_E(N)
          CALL MPI_WAIT(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      cpl2_wait_tim=cpl2_wait_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!***  The parents can now compute the new surface pressure on the
!***  nests' boundary points (overwriting the previous values).
!***  This must be done for both H points and V points.  Only the
!***  H point pressure is actually sent to the nest boundaries.
!***  The V point pressures are only used for proper vertical
!***  interpolation of V point boundary variables.
!-----------------------------------------------------------------------
!
      NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N))
!
!--------------------
!***  PD on H points
!--------------------
!
      btim=timef()
      CALL PARENT_UPDATE_CHILD_PSFC(FIS,PD,T,Q                          &  !<-- Native parent values
                                   ,PT,PDTOP                            &  !<-- Domain PT and PDTOP
                                   ,SG1,SG2                             &  !<-- General vertical structure (shared by all domains)
                                   ,IMS,IME,JMS,JME                     &  !<-- Parent task subdomain lateral memory dimensions
                                   ,LM                                  &  !<-- # of model layers
!
                                   ,NUM_CHILD_TASKS                     &  !<-- # of fcst tasks on child N
                         ,CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA   &  !<-- Integration limits on each task of child N
!
                                   ,FIS_CHILD_SOUTH(N)%TASKS            &  !<-- Sfc geopotential on Sbndry points on child tasks
                                   ,FIS_CHILD_NORTH(N)%TASKS            &  !<-- Sfc geopotential on Nbndry points on child tasks
                                   ,FIS_CHILD_WEST(N)%TASKS             &  !<-- Sfc geopotential on Wbndry points on child tasks
                                   ,FIS_CHILD_EAST(N)%TASKS             &  !<-- Sfc geopotential on Ebndry points on child tasks
! 
                                   ,NUM_TASKS_SEND_H_S(N)               &  !<-- # of child tasks with south boundary segments
                                   ,NUM_TASKS_SEND_H_N(N)               &  !<-- # of child tasks with north boundary segments
                                   ,NUM_TASKS_SEND_H_W(N)               &  !<-- # of child tasks with west boundary segments
                                   ,NUM_TASKS_SEND_H_E(N)               &  !<-- # of child tasks with east boundary segments
!
                                   ,PARENT_4_INDICES_H(N)%I_INDX_SBND   &  !<-- Parent I's west and east of each child Sbndry point
                                   ,PARENT_4_INDICES_H(N)%I_INDX_NBND   &  !<-- Parent I's west and east of each child Nbndry point
                                   ,PARENT_4_INDICES_H(N)%I_INDX_WBND   &  !<-- Parent I's west and east of each child Wbndry point
                                   ,PARENT_4_INDICES_H(N)%I_INDX_EBND   &  !<-- Parent I's west and east of each child Ebndry point
                                   ,PARENT_4_INDICES_H(N)%J_INDX_SBND   &  !<-- Parent J's south and north of each child Sbndry point
                                   ,PARENT_4_INDICES_H(N)%J_INDX_NBND   &  !<-- Parent J's south and north of each child Nbndry point
                                   ,PARENT_4_INDICES_H(N)%J_INDX_WBND   &  !<-- Parent J's south and north of each child Wbndry point
                                   ,PARENT_4_INDICES_H(N)%J_INDX_EBND   &  !<-- Parent J's south and north of each child Ebndry point
!
                             ,CHILDTASK_H_SAVE(N)%I_LO_SOUTH            &  !<-- Starting I on each south boundary child task
                             ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH            &  !<-- Ending I on each south boundary child task
                             ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER   &  !<-- Ending I on each south boundary child task
                             ,CHILDTASK_H_SAVE(N)%I_LO_NORTH            &  !<-- Starting I on each north boundary child task
                             ,CHILDTASK_H_SAVE(N)%I_HI_NORTH            &  !<-- Ending I on each north boundary child task
                             ,CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER   &  !<-- Ending I on each north boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_LO_WEST             &  !<-- Starting J on each west boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_HI_WEST             &  !<-- Ending J on each west boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER    &  !<-- Ending J on each west boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_LO_EAST             &  !<-- Starting J on each east boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_HI_EAST             &  !<-- Ending J on each east boundary child task
                             ,CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER    &  !<-- Ending J on each east boundary child task
!
                                  ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_SBND   &  !<-- Bilinear interpolation wgts of the four parent
                                  ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_NBND   &  !    points surrounding each child bndry point
                                  ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_WBND   &  !    on each side of the child boundary.
                                  ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_EBND   &  !
!
                                   ,N_BLEND_H_CHILD(N)                  &  !<-- Width of boundary blending region for mass points
                                   ,IM_CHILD(N)                         &  !<-- East-west points on child domain
                                   ,JM_CHILD(N)                         &  !<-- North-south points on child domain
!                                                                               ^
!                                                                               |
!                                                                             Input
!                                                                          --------------
!                                                                             Output
!                                                                               |   
!                                                                               v   
                                   ,CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS  &  !<-- 1-D H-pt Sbndry datastring to be sent by parent to child
                                   ,CHILD_BOUND_H_NORTH(N,INDX2)%TASKS  &  !<-- 1-D H-pt Nbndry datastring to be sent by parent to child
                                   ,CHILD_BOUND_H_WEST(N,INDX2)%TASKS   &  !<-- 1-D H-pt Wbndry datastring to be sent by parent to child
                                   ,CHILD_BOUND_H_EAST(N,INDX2)%TASKS   &  !<-- 1-D H-pt Ebndry datastring to be sent by parent to child
!
                                   ,PD_B_SOUTH(N)%TASKS                 &  !<-- Updated sigma domain pressure (Pa) on nest bndry points
                                   ,PD_B_NORTH(N)%TASKS                 &  !    for all four sides of nest N's boundary.
                                   ,PD_B_WEST(N)%TASKS                  &  !
                                   ,PD_B_EAST(N)%TASKS )                   !<--
!
!-----------------------------------------------------------------------
!
!--------------------
!***  PD on V points
!--------------------
!
      CALL PRESSURE_ON_NEST_BNDRY_V(PD                                  &  !<-- Sigma domain pressure (Pa) on parent mass points
                                   ,IMS,IME,JMS,JME                     &  !<-- Memory dimensions of PD
!
                                   ,PD_B_SOUTH(N)%TASKS                 &  !<-- Sigma domain pressure (Pa) on nest Sbndry mass points
                                   ,PD_B_NORTH(N)%TASKS                 &  !<-- Sigma domain pressure (Pa) on nest Nbndry mass points
                                   ,PD_B_WEST (N)%TASKS                 &  !<-- Sigma domain pressure (Pa) on nest Wbndry mass points
                                   ,PD_B_EAST (N)%TASKS                 &  !<-- Sigma domain pressure (Pa) on nest Ebndry mass points
! 
                                   ,NUM_TASKS_SEND_V_S(N)               &  !<-- # of child tasks with south boundary segments on V
                                   ,NUM_TASKS_SEND_V_N(N)               &  !<-- # of child tasks with north boundary segments on V
                                   ,NUM_TASKS_SEND_V_W(N)               &  !<-- # of child tasks with west boundary segments on V
                                   ,NUM_TASKS_SEND_V_E(N)               &  !<-- # of child tasks with east boundary segments on V
!
                                   ,CHILDTASK_V_SAVE(N)%I_LO_SOUTH      &  !<-- Starting I on each south V boundary child task 
                                   ,CHILDTASK_V_SAVE(N)%I_HI_SOUTH      &  !<-- Ending I on each south V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%I_LO_NORTH      &  !<-- Starting I on each north V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%I_HI_NORTH      &  !<-- Ending I on each north V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%J_LO_WEST       &  !<-- Starting J on each west V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%J_HI_WEST       &  !<-- Ending J on each west V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%J_LO_EAST       &  !<-- Starting J on each east V boundary child task
                                   ,CHILDTASK_V_SAVE(N)%J_HI_EAST       &  !<-- Ending J on each east V boundary child task
!
                                   ,CHILDTASK_H_SAVE(N)%I_LO_SOUTH      &  !<-- Starting I on each south H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH      &  !<-- Ending I on each south H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_LO_NORTH      &  !<-- Starting I on each north H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_NORTH      &  !<-- Ending I on each north H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_LO_WEST       &  !<-- Starting J on each west H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_WEST       &  !<-- Ending J on each west H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_LO_EAST       &  !<-- Starting J on each east H boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_EAST       &  !<-- Ending J on each east H boundary child task
!
                                   ,N_BLEND_H_CHILD(N)                  &  !<-- H rows in nests' boundary regions 
                                   ,N_BLEND_V_CHILD(N)                  &  !<-- V rows in nests' boundary regions
                                   ,IM_CHILD(N)                         &  !<-- East-west points on child domain
                                   ,JM_CHILD(N)                         &  !<-- North-south points on child domain
!
                                   ,INC_FIX(N)                          &  !<-- Increment used to select nest tasks for averaging H to V
!                                                                               ^
!                                                                               |
!                                                                             Input
!                                                                          --------------
!                                                                             Output
!                                                                               |   
!                                                                               v   
                                   ,PD_V                                &  !<-- Sigma domain pressure (Pa) on parent V points
                                   ,PD_B_SOUTH_V(N)%TASKS               &  !<-- Sigma domain pressure (Pa) on nest Sbndry V points
                                   ,PD_B_NORTH_V(N)%TASKS               &  !<-- Sigma domain pressure (Pa) on nest Nbndry V points
                                   ,PD_B_WEST_V(N)%TASKS                &  !<-- Sigma domain pressure (Pa) on nest Wbndry V points
                                   ,PD_B_EAST_V(N)%TASKS )                 !<-- Sigma domain pressure (Pa) on nest Ebndry V points
!
!-----------------------------------------------------------------------
!***  Now loop through the Solver internal state variables that the
!***  user has specified for the nest boundary conditions.  The 2-D
!***  PD array was already taken care of.  For the remaining variables
!***  find the number of dimensions and see whether they are on H or
!***  V points.
!-----------------------------------------------------------------------
!
      vars_bc: DO NV=1,NVARS_NESTBC                                        !<-- Loop over all nest BC variables updated by the parent.
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Field from the Bundle of Nest BC Vars"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_NESTBC            &  !<-- Bundle holding the arrays of nest BC update variables
                                ,fieldIndex =NV                       &  !<-- Index of the Field in the Bundle
                                ,field      =HOLD_FIELD               &  !<-- Field NV in the Bundle
                                ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract the Name of this Nest BC Variable"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldGet(field   =HOLD_FIELD                          &  !<-- Field NV in the Bundle
                          ,name    =FIELD_NAME                          &  !<-- This Field's name
                          ,dimCount=NUM_DIMS                            &  !<-- Is this Field 2-D or 3-D?
                          ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Is this an H-pt or a V-pt Variable?"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(field=HOLD_FIELD                         &  !<-- Get Attribute from this Field
                              ,name ='H_OR_V_INT'                       &  !<-- Name of the attribute to extract
                              ,value=H_OR_V_INT                         &  !<-- Value of the Attribute
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        IF(TRIM(FIELD_NAME)=='PD-nestbc')THEN
!
          CYCLE vars_bc                                                    !<-- PD was already taken care of.
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Get the desired boundary variable array from the Field and
!***  see whether it is on H or V points.
!-----------------------------------------------------------------------
!
!---------
!***  2-D
!---------
!
        IF(NUM_DIMS==2)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract the Nest BC Real 2-D Array from the Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the data pointer
                            ,localDe  =0                                &
                            ,farrayPtr=ARRAY_R2D                        &  !<-- Use this 2-D pointer to the variable.
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          NUM_LEVS=1                                                       !<-- # of vertical levels for this variable.
          LB_4D=1
          UB_4D=1
!
          LB1=LBOUND(ARRAY_R2D,1)
          UB1=UBOUND(ARRAY_R2D,1)
          LB2=LBOUND(ARRAY_R2D,2)
          UB2=UBOUND(ARRAY_R2D,2)
          ALLOCATE(VBL_ARRAY(LB1:UB1,LB2:UB2,1),stat=ISTAT)                !<-- Use only 3-D arrays in PARENT_UPDATE_CHILD_BNDRY below.
          IF(ISTAT/=0)THEN
            WRITE(0,20001)ISTAT
20001       FORMAT(' Failed to allocate VBL_ARRAY for 2-D variable  stat=',i4)
            WRITE(0,*)' Aborting!!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
!
          DO J=LB2,UB2
          DO I=LB1,UB1
            VBL_ARRAY(I,J,1)=ARRAY_R2D(I,J)                                !<-- Fill the 3-D array with the 2-D boundary variable.
          ENDDO
          ENDDO
!
!---------
!***  3-D
!---------
!
        ELSEIF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract the Nest BC Real 3-D Array from the Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the data pointer
                            ,localDe  =0                                &
                            ,farrayPtr=VBL_ARRAY                        &  !<-- Use this 3-D pointer to the variable.
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          NUM_LEVS=SIZE(VBL_ARRAY,3)                                       !<-- # of vertical levels for this 3-D boundary variable.
          LB_4D=1
          UB_4D=1
!
!---------
!***  4-D
!---------
!
        ELSEIF(NUM_DIMS==4)THEN                                            !<-- Possible only for H-pt boundary variables
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract the Nest BC Real 4-D Array from the Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the data pointer
                            ,localDe  =0                                &
                            ,farrayPtr=ARRAY_R4D                        &  !<-- Use this 4-D pointer to the variable.
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          LB_4D=LBOUND(ARRAY_R4D,4)
          UB_4D=UBOUND(ARRAY_R4D,4)
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  The parent computes the new values of the specified H-pt
!***  variables in the columns above the nest boundary points.
!-----------------------------------------------------------------------
!
        IF(H_OR_V_INT==1)THEN                                                 !<-- Value of 1 implies an H-point variable
!
          KOUNT_H=KOUNT_H+1                                                   !<-- Count the H-pt boundary variables (excluding PD)
!
          loop_4d: DO N4=LB_4D,UB_4D                                          !<-- Loop through 3-D sub-variables of 4-D variables, if any.
!
            IF(NUM_DIMS==4)THEN
              VBL_ARRAY=>ARRAY_R4D(:,:,:,N4)                                  !<-- Point at the current 3-D array in the 4-D variable.
              NUM_LEVS=SIZE(VBL_ARRAY,3)                                      !<-- # of vertical levels for this 3-D sub-variable.
            ENDIF
!
            CALL PARENT_UPDATE_CHILD_BNDRY(VBL_ARRAY                         &  !<-- Parent variable to interpolate to nest boundary
                                          ,TRIM(FIELD_NAME)                  &  !<-- Name of the variable
!
                                          ,PD,PT,PDTOP                       &  !<-- Parent PD; domain PT and PDTOP
                                          ,PSGML1,SGML2,SG1,SG2              &  !<-- General vertical structure (shared by all domains)
!
                                          ,PD_B_SOUTH(N)%TASKS               &  !<-- Sigma domain pressure (Pa) on nest Sbndry points
                                          ,PD_B_NORTH(N)%TASKS               &  !<-- Sigma domain pressure (Pa) on nest Nbndry points
                                          ,PD_B_WEST(N)%TASKS                &  !<-- Sigma domain pressure (Pa) on nest Wbndry points
                                          ,PD_B_EAST(N)%TASKS                &  !<-- Sigma domain pressure (Pa) on nest Ebndry points
!
                                          ,IMS,IME,JMS,JME                   &  !<-- Parent task subdomain lateral memory dimensions
                                          ,NUM_LEVS                          &  !<-- # of model layers in the given H-pt boundary variable
                                          ,0                                 &  !<-- # of rows to ignore on north/east nest boundaries
                                          ,N4                                &  !<-- Index of 4D array
!
                                          ,NUM_TASKS_SEND_H_S(N)             &  !<-- # of child tasks with south boundary segments
                                          ,NUM_TASKS_SEND_H_N(N)             &  !<-- # of child tasks with north boundary segments
                                          ,NUM_TASKS_SEND_H_W(N)             &  !<-- # of child tasks with west boundary segments
                                          ,NUM_TASKS_SEND_H_E(N)             &  !<-- # of child tasks with east boundary segments
!
                                         ,PARENT_4_INDICES_H(N)%I_INDX_SBND  &  !<-- Parent I's west and east of each child S bndry point
                                         ,PARENT_4_INDICES_H(N)%I_INDX_NBND  &  !<-- Parent I's west and east of each child N bndry point
                                         ,PARENT_4_INDICES_H(N)%I_INDX_WBND  &  !<-- Parent I's west and east of each child W bndry point
                                         ,PARENT_4_INDICES_H(N)%I_INDX_EBND  &  !<-- Parent I's west and east of each child E bndry point
                                         ,PARENT_4_INDICES_H(N)%J_INDX_SBND  &  !<-- Parent J's south and north of each child S bndry point
                                         ,PARENT_4_INDICES_H(N)%J_INDX_NBND  &  !<-- Parent J's south and north of each child N bndry point
                                         ,PARENT_4_INDICES_H(N)%J_INDX_WBND  &  !<-- Parent J's south and north of each child W bndry point
                                         ,PARENT_4_INDICES_H(N)%J_INDX_EBND  &  !<-- Parent J's south and north of each child E bndry point
!
                                   ,CHILDTASK_H_SAVE(N)%I_LO_SOUTH           &  !<-- Starting I on each south boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH           &  !<-- Ending I on each south boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER  &  !<-- Ending I for transfer to child on each Sbndry child task
                                   ,CHILDTASK_H_SAVE(N)%I_LO_NORTH           &  !<-- Starting I on each north boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_NORTH           &  !<-- Ending I on each north boundary child task
                                   ,CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER  &  !<-- Ending I for transfer to child on each Nbndry child task
                                   ,CHILDTASK_H_SAVE(N)%J_LO_WEST            &  !<-- Starting J on each west boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_WEST            &  !<-- Ending J on each west boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER   &  !<-- Ending J for transfer to child on each Wbndry child task
                                   ,CHILDTASK_H_SAVE(N)%J_LO_EAST            &  !<-- Starting J on each east boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_EAST            &  !<-- Ending J on each east boundary child task
                                   ,CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER   &  !<-- Ending J for transfer to child on each Ebndry child task
!
                                        ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_SBND  &  !<-- Bilinear interpolation wgts of the four parent
                                        ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_NBND  &  !    points surrounding each child bndry point.
                                        ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_WBND  &  !
                                        ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_EBND  &  !<--
!
                                          ,N_BLEND_H_CHILD(N)                &  !<-- Width of boundary blending region
                                          ,IM_CHILD(N)                       &  !<-- East-west points on child domain
                                          ,JM_CHILD(N)                       &  !<-- North-south points on child domain
!                                                                                    ^
!                                                                                    |
!                                                                                  Input
!                                                                               --------------
!                                                                                  Output
!                                                                                    |   
!                                                                                    v   
                                  ,BND_VAR_H_SOUTH(KOUNT_H)%CHILD(N)%TASKS   &  !<--
                                  ,BND_VAR_H_NORTH(KOUNT_H)%CHILD(N)%TASKS   &  !    Updated H-point variable on the four sides
                                  ,BND_VAR_H_WEST(KOUNT_H)%CHILD(N)%TASKS    &  !    of the nest domain boundary.
                                  ,BND_VAR_H_EAST(KOUNT_H)%CHILD(N)%TASKS    &  !<--
                                                                        )
!
          ENDDO loop_4d
!
!-----------------------------------------------------------------------
!***  The parent computes the new values of the specified velocity
!***  variables in the columns above the nest boundary points.
!-----------------------------------------------------------------------
!
!
        ELSEIF(H_OR_V_INT==2)THEN                                             !<-- Value of 2 implies a V-point variable
!
          KOUNT_V=KOUNT_V+1                                                   !<-- Count the V-pt boundary variables.
!
          CALL PARENT_UPDATE_CHILD_BNDRY(VBL_ARRAY                         &  !<-- Parent variable to interpolate to nest boundary
                                        ,TRIM(FIELD_NAME)                  &  !<-- Name of the variable
!
                                        ,PD_V,PT,PDTOP                     &  !<-- Parent PD on V; domain PT and PDTOP
                                        ,PSGML1,SGML2,SG1,SG2              &  !<-- General vertical structure (shared by all domains)
!
                                        ,PD_B_SOUTH_V(N)%TASKS             &  !<-- Sigma domain pressure (Pa) on nest Sbndry points
                                        ,PD_B_NORTH_V(N)%TASKS             &  !<-- Sigma domain pressure (Pa) on nest Nbndry points
                                        ,PD_B_WEST_V(N)%TASKS              &  !<-- Sigma domain pressure (Pa) on nest Wbndry points
                                        ,PD_B_EAST_V(N)%TASKS              &  !<-- Sigma domain pressure (Pa) on nest Ebndry points
!
                                        ,IMS,IME,JMS,JME                   &  !<-- Parent task subdomain lateral memory dimensions
                                        ,NUM_LEVS                          &  !<-- # of model layers
                                        ,1                                 &  !<-- # of rows to ignore on north/east nest boundaries
                                        ,1                                 &  !<-- Start index for the array variable
!
                                        ,NUM_TASKS_SEND_V_S(N)             &  !<-- # of child tasks with south boundary segments
                                        ,NUM_TASKS_SEND_V_N(N)             &  !<-- # of child tasks with north boundary segments
                                        ,NUM_TASKS_SEND_V_W(N)             &  !<-- # of child tasks with west boundary segments
                                        ,NUM_TASKS_SEND_V_E(N)             &  !<-- # of child tasks with east boundary segments
!
                                       ,PARENT_4_INDICES_V(N)%I_INDX_SBND  &  !<-- Parent I's west and east of each child S bndry point
                                       ,PARENT_4_INDICES_V(N)%I_INDX_NBND  &  !<-- Parent I's west and east of each child N bndry point
                                       ,PARENT_4_INDICES_V(N)%I_INDX_WBND  &  !<-- Parent I's west and east of each child W bndry point
                                       ,PARENT_4_INDICES_V(N)%I_INDX_EBND  &  !<-- Parent I's west and east of each child E bndry point
                                       ,PARENT_4_INDICES_V(N)%J_INDX_SBND  &  !<-- Parent J's south and north of each child S bndry point
                                       ,PARENT_4_INDICES_V(N)%J_INDX_NBND  &  !<-- Parent J's south and north of each child N bndry point
                                       ,PARENT_4_INDICES_V(N)%J_INDX_WBND  &  !<-- Parent J's south and north of each child W bndry point
                                       ,PARENT_4_INDICES_V(N)%J_INDX_EBND  &  !<-- Parent J's south and north of each child E bndry point
!
                                 ,CHILDTASK_V_SAVE(N)%I_LO_SOUTH           &  !<-- Starting I on each south boundary child task
                                 ,CHILDTASK_V_SAVE(N)%I_HI_SOUTH           &  !<-- Ending I on each south boundary child task
                                 ,CHILDTASK_V_SAVE(N)%I_HI_SOUTH_TRANSFER  &  !<-- Not relevant for V points
                                 ,CHILDTASK_V_SAVE(N)%I_LO_NORTH           &  !<-- Starting I on each north boundary child task
                                 ,CHILDTASK_V_SAVE(N)%I_HI_NORTH           &  !<-- Ending I on each north boundary child task
                                 ,CHILDTASK_V_SAVE(N)%I_HI_NORTH_TRANSFER  &  !<-- Not relevant for V points
                                 ,CHILDTASK_V_SAVE(N)%J_LO_WEST            &  !<-- Starting J on each west boundary child task
                                 ,CHILDTASK_V_SAVE(N)%J_HI_WEST            &  !<-- Ending J on each west boundary child task
                                 ,CHILDTASK_V_SAVE(N)%J_HI_WEST_TRANSFER   &  !<-- Not relevant for V points
                                 ,CHILDTASK_V_SAVE(N)%J_LO_EAST            &  !<-- Starting J on each east boundary child task
                                 ,CHILDTASK_V_SAVE(N)%J_HI_EAST            &  !<-- Ending J on each east boundary child task
                                 ,CHILDTASK_V_SAVE(N)%J_HI_EAST_TRANSFER   &  !<-- Not relevant for V points
!
                                      ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_SBND  &  !<-- Bilinear interpolation wgts of the four parent
                                      ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_NBND  &  !    points surrounding each child bndry point.
                                      ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_WBND  &  !
                                      ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_EBND  &  !<--
!
                                        ,N_BLEND_V_CHILD(N)                &  !<-- Width of boundary blending region
                                        ,IM_CHILD(N)                       &  !<-- East-west points on child domain
                                        ,JM_CHILD(N)                       &  !<-- North-south points on child domain
!                                                                                  ^
!                                                                                  |
!                                                                                Input
!                                                                             --------------
!                                                                                Output
!                                                                                  |   
!                                                                                  v   
                                ,BND_VAR_V_SOUTH(KOUNT_V)%CHILD(N)%TASKS   &  !<--
                                ,BND_VAR_V_NORTH(KOUNT_V)%CHILD(N)%TASKS   &  !    Updated V-point variable on the four sides
                                ,BND_VAR_V_WEST(KOUNT_V)%CHILD(N)%TASKS    &  !    of the nest domain boundary.
                                ,BND_VAR_V_EAST(KOUNT_V)%CHILD(N)%TASKS    &  !<--
                                                                        )
!
        ENDIF
!
        IF(NUM_DIMS==2.AND.ASSOCIATED(VBL_ARRAY))THEN
          DEALLOCATE(VBL_ARRAY,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,20002)ISTAT
20002       FORMAT(' Failed to deallocate VBL_ARRAY stat=',i4)
            WRITE(0,*)' Aborting!!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
          ENDIF
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDDO vars_bc
!
      cpl2_comp_tim=cpl2_comp_tim+(timef()-btim)
!
!-----------------------------------------------------------------------
!***  Parent tasks send data directly to those child tasks whose
!***  boundary points the parent tasks contain. 
!-----------------------------------------------------------------------
!
      IF(TIME_FLAG=='Current')THEN
        NSTEP_CHILD_RECV(N)=(NTIMESTEP+1)*TIME_RATIO_MY_CHILDREN(N)        !<-- Child "N" is waiting at this timestep to recv its data
      ELSEIF(TIME_FLAG=='Future')THEN
        NSTEP_CHILD_RECV(N)=NTIMESTEP*TIME_RATIO_MY_CHILDREN(N)            !<-- Child "N" is waiting at this timestep to recv its data
      ENDIF
!
      ID_ADD=1000*MY_CHILDREN_ID(N)
!
!-------------
!***  South H
!-------------
!
      NTAG=NSTEP_CHILD_RECV(N)+101+ID_ADD                                  !<-- Add 101 and child's domain ID to obtain a unique South H tag
!
      IF(NUM_TASKS_SEND_H_S(N)>0)THEN                                      !<-- Parent task has Sbndry H data to send to child tasks?     
!
        DO NT=1,NUM_TASKS_SEND_H_S(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NT,1)                     !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
!         call date_and_time(values=values)
!         write(0,221)n,nt,childtask,values(5),values(6),values(7),values(8)
  221     format(' Ready to send South_H to child #',i1,' task #',i1,' id #',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
!     write(0,22011)n,nt,childtask_bndry_h_ranks(n)%south(nt,1),childtask,ntag
!     write(0,22012)nstep_child_recv(n),id_add,my_children_id(n)
22011 format(' ready to send South_H to child #',i2,' task #',i3,' count=',i3,' rank=',i3,' tag=',i5)
22012 format(' nstep_child_recv(n)=',i5,' id_add=',i5,' my_children_id(n)=',i2)
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA   &  !<-- Child south boundary H data on child task NT
                         ,WORDS_BOUND_H_SOUTH(N)%TASKS(NT)              &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI intracommunicator
                         ,HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)    &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!     write(0,22013)n,nt,childtask_bndry_h_ranks(n)%south(nt,1),nrank,childtask
!     write(0,22014)words_bound_h_south(n)%tasks(nt),ntag,comm_to_my_children(n)                                 
!     write(0,22015)indx2,handle_h_south(n,indx2)%ntasks_to_recv(nt)
22013 format(' isent South_H to child #',i2,' task #',i3,' count=',i3,' nrank=',i3,' rank=',i3)
22014 format(' # of words=',i5,' ntag=',i5,' comm=',i12)
22015 format(' indx2=',i3,' handle_h_south(n,indx2)%ntasks_to_recv(nt)=',i12)
!
!         call date_and_time(values=values)
!         write(0,124)n,nt,childtask,values(5),values(6),values(7),values(8)
  124     format(' Sent South_H to child #',i1,' task #',i1,' id #',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
        ENDDO 
!
      ENDIF
!
!-------------
!***  South V
!-------------
!
      NTAG=NSTEP_CHILD_RECV(N)+102+ID_ADD                                  !<-- Add 102 and child's domain ID to obtain a unique South V tag
!
      IF(NUM_TASKS_SEND_V_S(N)>0)THEN                                      !<-- Parent task has Sbndry V data to send to child tasks?     
        DO NT=1,NUM_TASKS_SEND_V_S(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_V_RANKS(N)%SOUTH(NT,1)                     !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
!         call date_and_time(values=values)
!         write(0,125)n,nt,childtask,values(5),values(6),values(7),values(8)
! 125     format(' Ready to send South_V to child #',i1,' task #',i1,' id #',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA   &  !<-- Child south boundary V data on child task NT
                         ,WORDS_BOUND_V_SOUTH(N)%TASKS(NT)              &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)    &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
!         call date_and_time(values=values)
!         write(0,126)n,nt,childtask,values(5),values(6),values(7),values(8)
  126     format(' Sent South_V to child #',i1,' task #',i1,' id #',i3.3,' at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
!
        ENDDO 
      ENDIF
!
!-------------
!***  North H
!-------------
!
      NTAG=NSTEP_CHILD_RECV(N)+103+ID_ADD                                  !<-- Add 103 and child's domain ID to obtain a unique North H tag
!
      IF(NUM_TASKS_SEND_H_N(N)>0)THEN                                      !<-- Parent task has Nbndry H data to send to child tasks?     
        DO NT=1,NUM_TASKS_SEND_H_N(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NT,1)                     !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA   &  !<-- Child north boundary H data on child task NT
                         ,WORDS_BOUND_H_NORTH(N)%TASKS(NT)              &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)    &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO 
      ENDIF
!
!-------------
!***  North V
!-------------
!
      NTAG=NSTEP_CHILD_RECV(N)+104+ID_ADD                                  !<-- Add 104 and child's domain ID to obtain a unique North V tag
!
      IF(NUM_TASKS_SEND_V_N(N)>0)THEN                                      !<-- Parent task has Nbndry V data to send to child tasks?     
        DO NT=1,NUM_TASKS_SEND_V_N(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_V_RANKS(N)%NORTH(NT,1)                     !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA   &  !<-- Child north boundary V data on child task NT
                         ,WORDS_BOUND_V_NORTH(N)%TASKS(NT)              &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)    &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO 
      ENDIF
!
!------------
!***  West H
!------------
!
      NTAG=NSTEP_CHILD_RECV(N)+105+ID_ADD                                  !<-- Add 105 and child's domain ID to obtain a unique West H tag
!
      IF(NUM_TASKS_SEND_H_W(N)>0)THEN                                      !<-- Parent task has Wbndry H data to send to child tasks?     
        DO NT=1,NUM_TASKS_SEND_H_W(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NT,1)                      !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA    &  !<-- Child west boundary H data on child task NT
                         ,WORDS_BOUND_H_WEST(N)%TASKS(NT)               &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(NT)     &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO 
      ENDIF
!
!------------
!***  West V
!------------
!
      NTAG=NSTEP_CHILD_RECV(N)+106+ID_ADD                                  !<-- Add 106 and child's domain ID to obtain a unique West V tag
!
      IF(NUM_TASKS_SEND_V_W(N)>0)THEN                                      !<-- Parent task has Wbndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_W(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_V_RANKS(N)%WEST(NT,1)                      !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA    &  !<-- Child west boundary V data on child task NT
                         ,WORDS_BOUND_V_WEST(N)%TASKS(NT)               &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(NT)     &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO 
      ENDIF
!
!------------
!***  East H
!------------
!
      NTAG=NSTEP_CHILD_RECV(N)+107+ID_ADD                                  !<-- Add 107 and child's domain ID to obtain a unique East H tag
!
      IF(NUM_TASKS_SEND_H_E(N)>0)THEN                                      !<-- Parent task has Ebndry H data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_H_E(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NT,1)                      !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA    &  !<-- Child east boundary H data on child task NT
                         ,WORDS_BOUND_H_EAST(N)%TASKS(NT)               &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(NT)     &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO 
      ENDIF
!
!------------
!***  East V
!------------
!
      NTAG=NSTEP_CHILD_RECV(N)+108+ID_ADD                                  !<-- Add 108 and child's domain ID to obtain a unique East V tag
!
      IF(NUM_TASKS_SEND_V_E(N)>0)THEN                                      !<-- Parent task has Ebndry V data to send to child tasks?
        DO NT=1,NUM_TASKS_SEND_V_E(N)                                      !<-- Send to all appropriate child tasks
          NRANK=CHILDTASK_BNDRY_V_RANKS(N)%EAST(NT,1)                      !<-- Child task count in its list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Local rank of child task NT in p-c intracomm
!
          btim=timef()
          CALL MPI_ISSEND(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA    &  !<-- Child east boundary V data on child task NT
                         ,WORDS_BOUND_V_EAST(N)%TASKS(NT)               &  !<-- # of words in the data string
                         ,MPI_REAL                                      &  !<-- Datatype
                         ,CHILDTASK                                     &  !<-- Local rank of child to recv data
                         ,NTAG                                          &  !<-- MPI tag
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI communicator
                         ,HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(NT)     &  !<-- Handle for ISend to child N's task NT
                         ,IERR )
          cpl2_send_tim=cpl2_send_tim+(timef()-btim)
!
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE COMPUTE_SEND_NEST_BC_DATA
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENTS_SEND_CHILD_DATA
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENTS_RECV_CHILD_2WAY_DATA(CPL_COMP                  &
                                             ,IMP_STATE                 &
                                             ,EXP_STATE                 &
                                             ,CLOCK                     &
                                             ,RC_FINAL)
!
!-----------------------------------------------------------------------
!***  When 2-way nesting is being used the parents will receive
!***  internal update data from each of their children at the 
!***  start of every parent timestep.
!***  Only parents execute this routine that is called as phase 3
!***  of the Run step of the Parent-Child coupler in subroutine
!***  NMM_INTEGRATE.
!
!***  IMPORTANT:  The indices of the parent H points and V points
!***              that are updated by the children are identical.
!***              A signficant generalization will be needed if
!***              that ever changes.
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The NMM Clock for this parent domain
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ALLCLEAR_SIGNAL_TAG                         &
                           ,CHILDTASK,CHILDTASK_0,COMM_FCST_TASKS       &
                           ,ID_CHILD,L1,L2,MY_DOMAIN_ID,MYPE_LOCAL      &
                           ,N,N_ALL,NCHILD_TASKS,NL,NM,NMX,NPTS2        &
                           ,NPTS_UPDATE_HORIZ,NPTS_UPDATE_TOTAL         &
                           ,NT,NTIMESTEP,NTIMESTEP_CHILD,NUM_DIMS,NV    &
                           ,PARENT_TAG,SFC_TAG,TASK_ID,UPDATE_TAG
!
      INTEGER(kind=KINT) :: I_2WAY_UPDATE_START,I_2WAY_UPDATE_END       &
                           ,J_2WAY_UPDATE_START,J_2WAY_UPDATE_END
!
      INTEGER(kind=KINT) :: I_PARENT_SW_X,J_PARENT_SW_X
!
      INTEGER(kind=KINT) :: IERR,RC
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER,DIMENSION(:,:),POINTER :: CHILD_TASK_LIMITS
!
      REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: VAR_2WAY
!
      REAL(kind=KFPT),DIMENSION(:,:),ALLOCATABLE :: CHILD_SFC_ON_PARENT_GRID
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: VAR_PARENT_2D
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: VAR_PARENT_3D,VAR_3D
      REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: VAR_PARENT_4D
!
      LOGICAL(kind=KLOG),SAVE :: ALLCLEAR_SIGNAL=.TRUE.
!
!     LOGICAL(kind=KLOG) :: INTEGRATE_TIMESTEP                          &
!                          ,READY_TO_RECV                               &
      LOGICAL(kind=KLOG) :: READY_TO_RECV                               &
                           ,TWOWAY_SIGNAL_IS_PRESENT
!
      LOGICAL(kind=KLOG) :: ALLCLEAR_FROM_MY_PARENT
!
      CHARACTER(len=99) :: FIELD_NAME
!
      TYPE(CHILD_UPDATE_LINK),POINTER :: PTR
!
      TYPE(COMPOSITE),POINTER :: CC
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
      integer(kind=kint),dimension(8) :: values
      integer(kind=kint) :: mype_intra
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PARENTS_RECV_CHILD_2WAY_DATA:Extract Fcst Task Intracom"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Current domain's intracomm for fcst tasks
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL MPI_COMM_RANK(COMM_FCST_TASKS,MYPE_LOCAL,IERR)                  !<-- Local task rank in this domain's fcst tasks
!
!-----------------------
!***  Current Domain ID
!-----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PARENTS_RECV_CHILD_2WAY_DATA: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Point to the correct part of the composite object which will
!***  align working variables with values associated with this domain.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)                                      !<-- Use dummy for shorter reference to composite
!
!-----------------------------------------------------------------------
!***  Get the current timestep.
!-----------------------------------------------------------------------
!
      CALL ESMF_CLOCKGET(CLOCK       =CLOCK                             &  !<-- The ESMF Clock
                        ,advanceCount=NTIMESTEP_ESMF                    &  !<-- The parent's current timestep (ESMF)
                        ,rc          =rc)
!
      NTIMESTEP=NTIMESTEP_ESMF                                             !<-- The current parent timestep
!
!-----------------------------------------------------------------------
!***  At this point all the children's 2-way data is ready to be 
!***  received.  There is one more issue that must be considered.
!***  If any of the 2-way children has just shifted then the points
!***  updated by such children have just changed so bookkeeping must
!***  first be done so the parent knows the correct points to have
!***  updated.  If this parent has just moved in this timestep then
!***  it must do the bookkeeping for all its children (currently a
!***  domain that moves can have only moving children and not static
!***  ones) to know which of its points will be updated.
!***  Below is a diagram illustrating the relationship between a child's
!***  move and the parent's need to execute 2-way bookkeeping after that
!***  child's move.  In this instance the parent was informed by the
!***  child that the child would move at the start of the child's 
!***  timestep 24 (parent timestep 8) therefore the parent must prepare
!***  and deposit move data at the end of its timestep 7.  (The parent-
!***  child timestep ratio is 3.)  The parent first recvs 2-way update
!***  data from the child's new position at the beginning of parent 
!***  timestep 9.
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!                      ----------------------------------
!                       Parent-child timestep ratio is 3
!                      ----------------------------------
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!                   Child shifts at start of its timestep 24
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!               parent                                             parent
!        7 <-- timestep --> 8                               8 <-- timestep --> 9
!              boundary                                           boundary
!
!                  |                                                  |
!    parent sends  |  child recvs                                     |  
!     post-shift   |  post-shift                                      | 
!   internal data  |  internal data                                   | 
!      to child    |  from parent                                     |
!          |       |   |                                              |
!          |       |   |                                              |
!          v       |   v                                              |
!                  |       ^                                          |
!                  |       |                                          |
!                  |       |      child            child              |
!                  |     CHILD   timestep         timestep            |
!                  |     SHIFTS  boundary         boundary            |
!                  |     HERE       |                |                |
!                  |       |        |                |                |
!             23<--|-->24  |   24<--|-->25      25<--|-->26      26<--|-->27
!                  |       v        |                |                |
!                  |                |                |                |
!                  |                                                  |
!                  |                                                  |
!                  |                                                  |
!              ^   |     ^                                        ^   |      ^
!              |   |     |                                        |   |      |
!              |   |     |                                        |   |      |
!    child sends   |  parent recvs                      child sends   |  parent recvs
!    pre-shift     |  pre-shift                         post-shift    |  post-shift
!    2-way data    |  2-way data                        2-way data    |  2-way data
!    to parent     |  from child                        to parent     |  from child
!                  |                                                  |
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!***  Below is an example of the parent domain shifting at the start
!***  of its timestep 8.  However the parent receives and incorporates
!***  the 2-way data from its child in that timestep BEFORE the shift
!***  in position occurs therefore the child generates that data for
!***  the parent's pre-shift position.
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!                   Parent shifts at start of its timestep 8
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
!               parent                                             parent
!        7 <-- timestep --> 8                               8 <-- timestep --> 9
!              boundary                                           boundary
!
!                  |                                                  |
!                  |                                                  |  
!                  |     PARENT                                       | 
!                  |     SHIFTS                                       |
!                  |      HERE                                        |
!                  |       |                                          |
!                  |       |                                          |
!                  |       |                                          |
!                  |       v                                          |
!                  |             child            child               |
!                  |            timestep         timestep             |
!                  |            boundary         boundary             |
!                  |                |                |                |
!                  |                |                |                |
!             23<--|-->24      24<--|-->25      25<--|-->26      26<--|-->27
!                  |                |                |                |
!                  |                |                |                |
!                  |                                                  |
!                  |                                                  |
!                  |                                                  |
!              ^   |    ^                                             |
!              |   |    |                                             |
!              |   |    |                                             |
!     child sends  |  parent recvs/                                   |
!     pre-shift    |  incorporates                                    |
!     2-way data   |  pre-shift                                       |
!     to parent    |  2-way data                                      |
!                  |  from child                                      |
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
      two_way_children: DO N=1,NUM_2WAY_CHILDREN                           !<-- Loop through all of this domain's 2-way children
!
!-----------------------------------------------------------------------
!
        N_ALL=RANK_2WAY_CHILD(N)                                           !<-- Rank of 2-way child N among ALL children
        NM=1
        call mpi_comm_rank(comm_to_my_children(n_all),mype_intra,ierr)
!
        IF(STATIC_OR_MOVING(N_ALL)=='Moving')THEN                          !<-- If so, 2-way child N's domain is movable.
!
          DO NMX=1,NUM_MOVING_CHILDREN
            IF(N_ALL==RANK_MOVING_CHILD(NMX))THEN                          !<-- Which moving child is 2-way child N?
              NM=NMX                                                       !<-- 2-way child N is moving child NM
              EXIT
            ENDIF
          ENDDO
!
        ENDIF
!        
        IF(.NOT.CALLED_PARENT_2WAY_BOOKKEEPING(N)                       &  !<-- Initial parent bookkeeping for all 2-way nests
                         .OR.                                           &
           NTIMESTEP==NTIMESTEP_CHILD_MOVES(NM)+1                       &  !<-- 2-way child N moved one parent timestep ago
                         .OR.                                           &
           NTIMESTEP==NEXT_MOVE_TIMESTEP+1)THEN                            !<-- This parent moved in its preceding timestep
!
!-----------------------------------------------------------------------
!***  If this parent moved in its preceding timestep then it
!***  needs to modify the locations of its children accordingly.
!***  This will be done as a local computation because 2-way nesting
!***  is only optional.  The children's locations as changed by
!***  the parent's shift will be permanently modified in 
!***  PARENTS_SEND_CHILD_DATA where it is always required for
!***  generation of BC update data to send to the children.
!-----------------------------------------------------------------------
!
          I_PARENT_SW_X=I_PARENT_SW(N_ALL)
          J_PARENT_SW_X=J_PARENT_SW(N_ALL)
!
!-----------------------------------------------------------------------
!***  Parent tasks determine which if any of their points are updated
!***  by 2-way child N in that child's or the parent's new location.
!-----------------------------------------------------------------------
!
          NTASKS_UPDATE_CHILD(N)=0                                            !<-- Initialize # of child tasks that will update
          CHILD_TASK_LIMITS=>CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N_ALL)%DATA  !<-- All subdomain limits on 2-way child N's domain
          ID_CHILD=MY_CHILDREN_ID(N_ALL)                                      !<-- Domain ID of 2-way child N
!
          CALL PARENT_2WAY_BOOKKEEPING(PARENT_CHILD_SPACE_RATIO(N_ALL)  &  !<-- Ratio of parent grid increment to 2-way child N's
                                      ,FTASKS_DOMAIN(ID_CHILD)          &  !<-- # of forecast tasks on 2-way child N's domain
                                      ,CHILD_TASK_LIMITS                &  !<-- 2-way child N's subdomains' integration limits
                                      ,IM_CHILD(N_ALL)                  &  !<-- I extent of 2-way child N's domain
                                      ,JM_CHILD(N_ALL)                  &  !<-- J extent of 2-way child N's domain 
                                      ,I_PARENT_SW_X                    &  !<-- Parent I of SW corner of child domain N_ALL
                                      ,J_PARENT_SW_X                    &  !<-- Parent J of SW corner of child domain N_ALL
                                      ,N_BLEND_H_CHILD(N_ALL)           &  !<-- H-pt blending region width for 2-way child N
                                      ,N_BLEND_V_CHILD(N_ALL)           &  !<-- V-pt blending region width for 2-way child N
                                      ,N_STENCIL_H_CHILD(N)             &  !<-- Stencil width for averaging child h to parent H
                                      ,N_STENCIL_V_CHILD(N)             &  !<-- Stencil width for averaging child v to parent V
                                      ,N_STENCIL_SFC_H_CHILD(N)         &  !<-- Stencil width for averaging child fis,pd to parent H
                                      ,N_STENCIL_SFC_V_CHILD(N)         &  !<-- Stencil width for averaging child fis,pd to parent V
                                      ,ITS,ITE,JTS,JTE                  &  !<-- Integration limits of this parent task subdomain
!
                                      ,NTASKS_UPDATE_CHILD(N)           &  !<-- # of tasks on 2-way child N that update this parent task
                                      ,CHILD_TASKS_2WAY_UPDATE(N)       &  !<-- Info for 2-way child N's update on this parent task
                                                                  )
!
          CALLED_PARENT_2WAY_BOOKKEEPING(N)=.TRUE.
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  The parent receives update data from child N.
!-----------------------------------------------------------------------
!
        IF(NTASKS_UPDATE_CHILD(N)<1)THEN
          CYCLE                                                            !<-- Skip this child if none of its tasks are sending data.
        ENDIF
!
        NCHILD_TASKS=NTASKS_UPDATE_CHILD(N)                                !<-- # of child N's tasks that update the parent task.
        NTIMESTEP_CHILD=NTIMESTEP*TIME_RATIO_MY_CHILDREN(N_ALL)-1          !<-- Child's timestep when it sent the data.
!
        PTR=>CHILD_TASKS_2WAY_UPDATE(N)                                    !<-- Point at child N's 2-way exchange specifications
!
!-----------------------------------------------------------------------
!
        child_tasks: DO NT=1,NCHILD_TASKS                                  !<-- Loop though child N's tasks that send 2-way data
!
!-----------------------------------------------------------------------
!
          IF(NT>1)PTR=>PTR%NEXT_LINK                                       !<-- Advance through this child's tasks that are sending data
!
          NPTS_UPDATE_TOTAL=NLEV_2WAY*PTR%NUM_PTS_UPDATE_HZ                !<-- Total # of values (Real) updated by child N's task NT.
          ALLOCATE(VAR_2WAY(1:NPTS_UPDATE_TOTAL))                          !<-- The recv buffer
!
          TASK_ID=PTR%TASK_ID                                               !<-- Local rank of task NT among child N's fcst tasks.
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N_ALL)%DATA(TASK_ID) !<-- Local rank of child task NT in P-C intracommunicator.
          UPDATE_TAG=100*MY_CHILDREN_ID(N_ALL)+CHILDTASK
!
          CALL MPI_RECV(VAR_2WAY                                        &  !<-- All update values from child N's task NT
                       ,NPTS_UPDATE_TOTAL                               &  !<-- Receiving this many words
                       ,MPI_REAL                                        &  !<-- The data is real
                       ,CHILDTASK                                       &  !<-- Data was sent by this nest task
                       ,UPDATE_TAG                                      &  !<-- The MPI tag
                       ,COMM_TO_MY_CHILDREN(N_ALL)                      &  !<-- Intracommunicator between current domain and child N_ALL
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
!
          NPTS_UPDATE_HORIZ=2*PTR%NUM_PTS_UPDATE_HZ                        !<-- # of sfc H,V points updated on parent by child N's task NT.
          ALLOCATE(CHILD_SFC_ON_PARENT_GRID(1:NPTS_UPDATE_HORIZ,1:2))      !<-- The recv buffer
          NPTS2=2*NPTS_UPDATE_HORIZ                                        !<-- Total # of points in CHILD_SFC_ON_PARENT_GRID 
                                                                           !    (child N's FIS,PD interpolated to parent H and V)
          SFC_TAG=100*MY_CHILDREN_ID(N_ALL)+CHILDTASK
!
          CALL MPI_RECV(CHILD_SFC_ON_PARENT_GRID                        &  !<-- Child PD,FIS interpolated to parent points
                       ,NPTS2                                           &  !<-- Receiving this many words
                       ,MPI_REAL                                        &  !<-- The data is real
                       ,CHILDTASK                                       &  !<-- Data was sent by this nest task
                       ,SFC_TAG                                         &  !<-- The MPI tag
                       ,COMM_TO_MY_CHILDREN(N_ALL)                      &  !<-- Intracommunicator between current domain and child N_ALL
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
!
!-----------------------------------------------------------------------
!***  The parent does not incorporate data sent from the child if
!***  this is a parent timestep that immediately follows the writing
!***  of a restart file.  This ensures bit-reproducible restarts.
!***  A child sends 2-way data to its parent at the end of parent
!***  timestep N and the parent receives that data early in timestep
!***  N+1.  Two-way data is not in the restart files so in a restart
!***  the parent sees no 2-way data coming from its children in the
!***  first timestep.  Therefore the parent must not use 2-way data
!***  from the children in any parent timestep that follows the
!***  writing of a restart file.
!-----------------------------------------------------------------------
!
          no_restart: IF(MOD(NTIMESTEP,NTIMESTEPS_RESTART)/=0)THEN
!
!-----------------------------------------------------------------------
!***  The parent incorporates the 2-way data sent from child N's
!***  task NT.
!-----------------------------------------------------------------------
!
            I_2WAY_UPDATE_START=PTR%IL(1)                                  !<-- Starting parent I updated by child N's task NT
            I_2WAY_UPDATE_END  =PTR%IL(2)                                  !<-- Ending parent I updated by child N's task NT
            J_2WAY_UPDATE_START=PTR%JL(1)                                  !<-- Starting parent J updated by child N's task NT
            J_2WAY_UPDATE_END  =PTR%JL(2)                                  !<-- Ending parent J updated by child N's task NT
!
            IF(.NOT.SKIP_2WAY_UPDATE(N_ALL))THEN                           !<-- IF test passes => nest N lies within latitude limits
              CALL PARENT_2WAY_UPDATE(I_2WAY_UPDATE_START               &  !<-- # of tasks on 2-way child N that update this parent task
                                     ,I_2WAY_UPDATE_END                 &  !<-- Info for 2-way child N's update on this parent task
                                     ,J_2WAY_UPDATE_START               &  !<-- Info for 2-way child N's update on this parent task
                                     ,J_2WAY_UPDATE_END                 &  !<-- Info for 2-way child N's update on this parent task
                                     ,LM                                &  !<-- # of model layers (all domains)
                                     ,NPTS_UPDATE_HORIZ                 &  !<-- # of update parent sfc H,V points
                                     ,NPTS_UPDATE_TOTAL                 &  !<-- Total # of words in 2-way 3D update data from child
                                     ,NVARS_2WAY_UPDATE                 &  !<-- # of variables updated in 2-way exchange
                                     ,VAR_2WAY                          &  !<-- String of all 2-way update data from child
                                     ,CHILD_SFC_ON_PARENT_GRID          &  !<-- Child's FIS,PD interpolated to parent update points
                                     ,CHILD_2WAY_WGT(N)                 &  !<-- Weight (0-1) given to child 2-way data in the update
                                     ,FIS                               &  !<-- Parent's sfc geopotential
                                     ,PD,PDTOP,PT                       &  !<-- Parent's PD
                                     ,SG1,SG2                           &  !<-- Interface 'sigma' values in pressure/hybrid regions
                                     ,IMS,IME,JMS,JME                   &  !<-- Memory limits of parent subdomains
!
                                     ,BUNDLE_2WAY                       &  !<-- Bundle holding pointers to the 2-way exchange variables
                                                 )
            ENDIF
!
!-----------------------------------------------------------------------
!
          ENDIF no_restart
!
!-----------------------------------------------------------------------
!
          DEALLOCATE(VAR_2WAY)
          DEALLOCATE(CHILD_SFC_ON_PARENT_GRID)
!
!-----------------------------------------------------------------------
!
        ENDDO child_tasks
!
!-----------------------------------------------------------------------
!
      ENDDO two_way_children
!
!-----------------------------------------------------------------------
!
      KOUNT_2WAY_CHILDREN=0
!
!-----------------------------------------------------------------------
!***  The parent tasks have received all the 2-way exchange data from
!***  their children.  The lead parent task now informs the lead
!***  child tasks that the children are now free to proceed to the
!***  beginning of the next parent timestep since the parent will now
!***  be able to integrate its next step and send back BC data to the
!***  children.  Until the children are informed of this by their
!***  parents at the end of each parent timestep the children will
!***  simply continue to fall out of the integration loop in
!***  NMM_INTEGRATE.
!-----------------------------------------------------------------------
!
      task0_b: IF(I_AM_LEAD_FCST_TASK)THEN
!
!-----------------------------------------------------------------------
!
        DO N=1,NUM_CHILDREN
!
          ALLCLEAR_SIGNAL_TAG=20000+1000*MY_CHILDREN_ID(N)              &  !<-- Use child's domain ID, timestep to create a unique tag
                              +10*NTIMESTEP*TIME_RATIO_MY_CHILDREN(N)
          CHILDTASK_0=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(0)        !<-- Local rank of child's lead task in p-c communicator
!
          CALL MPI_WAIT(HANDLE_SEND_ALLCLEAR(N)                         &  !<-- Handle for this ISend
                       ,JSTAT                                           &  !<-- MPI status object 
                       ,IERR)
!
          CALL MPI_ISSEND(ALLCLEAR_SIGNAL                               &  !<-- Send signal to children they may now integrate
                         ,1                                             &  !<-- # of words in signal
                         ,MPI_LOGICAL                                   &  !<-- The signal is type Logical (it is TRUE)
                         ,CHILDTASK_0                                   &  !<-- The signal was sent by child N's fcst task 0.
                         ,ALLCLEAR_SIGNAL_TAG                           &  !<-- Tag to free the children to integrate
                         ,COMM_TO_MY_CHILDREN(N)                        &  !<-- MPI intracommunicator between parent and moving child N
                         ,HANDLE_SEND_ALLCLEAR(N)                       &
                         ,IERR)
!
        ENDDO
!
!-----------------------------------------------------------------------
!
      ENDIF task0_b
!
!-----------------------------------------------------------------------
!
      CALL SET_DOMAIN_SPECS(ITS,ITE,JTS,JTE                             &
                           ,IMS,IME,JMS,JME                             &
                           ,IDS,IDE,JDS,JDE                             &
                           ,NHALO,NHALO                                 &
                           ,MY_DOMAIN_ID                                &
                           ,MYPE_LOCAL                                  &
                           ,MY_NEB                                      &
                           ,COMM_FCST_TASKS                             &
                           ,NUM_PES_FCST                                &
                            )
!
!-----------------------------------------------------------------------
!***  Now that parent variables have been modified by each of the
!***  children who have contributions the parent's halos need to
!***  be updated.  Therefore extract each of the 2-way exchange
!***  variables from the Bundle and call the halo exchange.
!-----------------------------------------------------------------------
!
      vars: DO NV=1,NVARS_2WAY_UPDATE                                     !<-- Loop over all parent exchange variables updated by the child.
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Field from the Bundle of 2-way Vars"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_2WAY              &  !<-- Bundle holding pointers to the 2-way exchange variables
                                ,fieldIndex =NV                       &  !<-- Index of the Field in the Bundle
                                ,field      =HOLD_FIELD               &  !<-- Field NV in the Bundle
                                ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Info about this 2-way Variable"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldGet(field   =HOLD_FIELD                        &  !<-- Field NV in the Bundle
                          ,dimCount=NUM_DIMS                          &  !<-- Is this Field 2-D or 3-D?
                          ,typeKind=DATATYPE                          &  !<-- Does the Field contain an integer or real array?
                          ,name    =FIELD_NAME                        &  !<-- This Field's name
                          ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
        IF(NUM_DIMS==2)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Real 2-way 2-D Array from the Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the exchange variable pointer
                            ,localDe  =0                                &
                            ,farrayPtr=VAR_PARENT_2D                    &  !<-- Put the pointer here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL HALO_EXCH(VAR_PARENT_2D,LM,2,2)
!
!-----------------------------------------------------------------------
!
        ELSEIF(NUM_DIMS>=3)THEN
!
!-----------------------------------------------------------------------
!
          IF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Real 2-way 3-D Array from the Field"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the exchange variable pointer
                              ,localDe  =0                                &
                              ,farrayPtr=VAR_PARENT_3D                    &  !<-- Put the pointer here
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            L1=1
            L2=1
            VAR_3D=>VAR_PARENT_3D
!
          ELSEIF(NUM_DIMS==4)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Real 2-way 4-D Array from the Field"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the exchange variable pointer
                              ,localDe  =0                                &
                              ,farrayPtr=VAR_PARENT_4D                    &  !<-- Put the pointer here
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            L1=LBOUND(VAR_PARENT_4D,4)
            L2=UBOUND(VAR_PARENT_4D,4)
!
          ENDIF
!
          DO NL=L1,L2
!
            IF(NUM_DIMS==4)THEN
              VAR_3D=>VAR_PARENT_4D(:,:,:,NL)                                !<-- Point at NL'th 3-D array in the 4-D variable.
            ENDIF
!
            CALL HALO_EXCH(VAR_3D,LM,2,2)
!
          ENDDO
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDDO vars
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENTS_RECV_CHILD_2WAY_DATA
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE CHILDREN_SEND_PARENTS_2WAY_DATA(CPL_COMP               &
                                                ,IMP_STATE              &
                                                ,EXP_STATE              &
                                                ,CLOCK                  &
                                                ,RC_FINAL)
!
!-----------------------------------------------------------------------
!***  Run the coupler step where children send their 2-way exchange
!***  data to their parents.  This is phase 5 of the Parent-Child
!***  coupler Run step called in subroutine NMM_INTEGRATE and takes
!***  place at the end of a parent timestep after the parents execute
!***  their receiving and incorporation of 2-way exchanges from their
!***  children which occurred in phase 2 at the beginning of the parent
!***  timestep.  Of course this routine is executed only if 2-way 
!***  nesting is being used.
!
!***  IMPORTANT:  The specific indices of the parent H points and V 
!***              points that are updated by the children are identical.
!***              A signficant generalization will be needed if that
!***              fact ever changes.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT),SAVE :: H_OR_V_INT,NTOT,NTOT_H_V
!
      INTEGER(kind=KINT) :: L1,L2,MY_DOMAIN_ID,MY_PARENT_ID             &
                           ,N,N_STENCIL,N_STENCIL_SFC                   &
                           ,N1,N1P,N2,N2P,NL,NT,NTAG,NTIMESTEP          &
                           ,NUM_DIMS,NV,NVERT,NX,NY
!
      INTEGER(kind=KINT) :: I_SW_PARENT_CURRENT_X                       &
                           ,J_SW_PARENT_CURRENT_X
!
      INTEGER(kind=KINT) :: LB1,LB2,UB1,UB2
!
      INTEGER(kind=KINT) :: IERR,RC
!
      INTEGER(kind=ESMF_KIND_I8) :: NTIMESTEP_ESMF
!
      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER(kind=KINT),DIMENSION(1:2) :: LBND,UBND
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: I_2WAY,I_2WAY_X        &
                                                ,J_2WAY,J_2WAY_X
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: VAR_PARENT
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: ARRAY_2WAY_R2D
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: CHILD_SFC_INTERP
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: ARRAY_2WAY_R3D        &
                                                 ,VAR_CHILD
!
      REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: ARRAY_2WAY_R4D
!
      LOGICAL(kind=KLOG) :: INTERPOLATE_SFC
!
      LOGICAL(kind=KLOG),SAVE :: BEGIN_H,BEGIN_V                        &
                                ,MY_2WAY_SIGNAL=.TRUE.
!
      CHARACTER(len=1) :: H_OR_V
!
      CHARACTER(len=99) :: FIELD_NAME
!
      LOGICAL(kind=KLOG) :: MOVE_NOW
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
      TYPE(COMPOSITE),POINTER :: CC
!
      integer(kind=kint),dimension(8) :: values
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!--------------------------
!***  The current timestep
!--------------------------
!
      CALL ESMF_CLOCKGET(clock       =CLOCK                             &
                        ,advanceCount=NTIMESTEP_ESMF                    &
                        ,rc          =RC)
!
      NTIMESTEP=NTIMESTEP_ESMF
!
!-----------------------
!***  Current Domain ID
!-----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="CHILDREN_SEND_PARENTS_2WAY_DATA: Extract Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Point to the correct part of the composite object which will
!***  align working variables in this task's memory with values
!***  associated with this particular domain.
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Did this domain move at the beginning of this timestep?
!-----------------------------------------------------------------------
!
      IF(MY_DOMAIN_MOVES.AND..NOT.FIRST_STEP_2WAY)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="CHILDREN_SEND_PARENTS_2WAY_DATA: Extract Move Flag"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE                          &  !<-- The parent-child coupler export state
                              ,name ='MOVE_NOW'                         &  !<-- Name of the attribute to extract
                              ,value=MOVE_NOW                           &  !<-- Did this child just move?
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
      IF(FIRST_STEP_2WAY)THEN
        FIRST_STEP_2WAY=.FALSE.
      ENDIF
!
!-----------------------------------------------------------------------
!
      CALL MPI_COMM_RANK(COMM_TO_MY_PARENT,MYPE,IERR)                      !<-- Obtain my local rank in parent-child intracomm
!
!-----------------------------------------------------------------------
!***  The lead child task now sends the lead parent task a signal
!***  indicating that the child has caught up to the parent in time 
!***  and is ready to send its 2-way exchange data.
!***  A child must never send its signal to its parent at the end
!***  of the final timestep of the forecast since the parent would
!***  need to go one timestep beyond the end of the forecast in
!***  order to receive that signal.
!-----------------------------------------------------------------------
!
      IF(NTIMESTEP<NTIMESTEP_FINAL)THEN
!
        IF(I_AM_LEAD_FCST_TASK)THEN                                        !<-- Local task 0 on this child domain ISends
!
          TWOWAY_SIGNAL_TAG=1115+1000*MY_DOMAIN_ID+10*NTIMESTEP            !<-- Use child's domain ID,timestep to create a unique tag
!
          CALL MPI_WAIT(HANDLE_SEND_2WAY_SIGNAL                         &  !<-- Handle for this ISend
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
!
          CALL MPI_ISSEND(MY_2WAY_SIGNAL                                &  !<-- The child's affirmative 2-way signal
                         ,1                                             &  !<-- The signal has 1 word
                         ,MPI_LOGICAL                                   &  !<-- The signal is type Logical
                         ,0                                             &  !<-- Target the parent lead task in the p-c intracomm
                         ,TWOWAY_SIGNAL_TAG                             &  !<-- Tag associated with 2way signal from children
                         ,COMM_TO_MY_PARENT                             &  !<-- The intracommunicator between this child and its parent
                         ,HANDLE_SEND_2WAY_SIGNAL                       &  !<-- Handle for this ISend
                         ,IERR )
!
        ENDIF
!
      ELSE
!
        RETURN                                                             !<-- Send nothing to parent if it is the final timestep.
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Clear the buffers from this child task's previous sends.
!-----------------------------------------------------------------------
!
      IF(NTASKS_UPDATE_PARENT>0)THEN
        DO NT=1,NTASKS_UPDATE_PARENT                                       !<-- Loop through parent task subdomains updated last time.
!
          CALL MPI_WAIT(HANDLE_SEND_2WAY_DATA(NT)                       &  !<-- Request handle for ISend of update to parent task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
!
          CALL MPI_WAIT(HANDLE_SEND_2WAY_SFC(NT)                        &  !<-- Request handle for ISend of FIS,PD to parent task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
!
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!***  Each child task determines the parent tasks to which it must
!***  provide update data and to which points on those parent tasks.
!***  This needs to be done only once for static nests.  For moving
!***  nests it must be done initially and then again each time the
!***  child or parent has moved at the beginning of this parent 
!***  timestep.  Recall that at this point in time the child
!***  is at the end of a parent timestep and that the parent will
!***  receive 2-way update data from this child at the beginning
!***  of the next parent timestep.  In timesteps that the parent
!***  shifts the parent will incorporate the 2-way data BEFORE the 
!***  the shift of data actually occurs in DOMAIN_RUN.  Therefore
!***  the child always generates 2-way data for the parent's
!***  position valid for the same time at which the child is 
!***  doing the 2-way data generation.
!
!***  Recall that the child's I,J of its southwest corner on its
!***  parent's grid is part of the composite object and thus is
!***  always retained.  However the change of that corner location
!***  due to the parent's upcoming shift is computed locally here
!***  because 2-way exchange is only optional.  The location of
!***  the child's SW corner due the motion of its parent will be
!***  permanently updated in CHILD_RECV_PARENT_DATA where the
!***  computation is always needed for receiving BC updates.
!-----------------------------------------------------------------------
!
      I_SW_PARENT_CURRENT_X=I_SW_PARENT_CURRENT
      J_SW_PARENT_CURRENT_X=J_SW_PARENT_CURRENT
!
!-----------------------------------------------------------------------
!
      IF(.NOT.CALLED_CHILD_2WAY_BOOKKEEPING                             &  !<-- All nests' first update of their parents.
                      .OR.                                              &
         MY_DOMAIN_MOVES.AND.MOVE_NOW                                   &  !<-- This child moved at the start of this parent timestep.
                      .OR.                                              &
         MY_DOMAIN_MOVES                                                &
               .AND.                                                    &
         NTIMESTEP==PARENT_SHIFT(1)*TIME_RATIO_MY_PARENT                &  !<-- Parent moved at the start of 
                    +TIME_RATIO_MY_PARENT-1)THEN                           !<-- the current parent timestep.
!                            
        MY_PARENT_ID=ID_PARENTS(MY_DOMAIN_ID)                              !<-- Domain ID of the current domain's parent
!
        CALL CHILD_2WAY_BOOKKEEPING(I_SW_PARENT_CURRENT_X               &  !   ^
                                   ,J_SW_PARENT_CURRENT_X               &  !   |
                                   ,SPACE_RATIO_MY_PARENT               &  !   |
                                   ,NUM_FCST_TASKS_PARENT               &  !   |
                                   ,PTASK_LIMITS(MY_DOMAIN_ID)%ITS      &  !   |
                                   ,PTASK_LIMITS(MY_DOMAIN_ID)%ITE      &  !   |
                                   ,PTASK_LIMITS(MY_DOMAIN_ID)%JTS      &  !   |
                                   ,PTASK_LIMITS(MY_DOMAIN_ID)%JTE      &  !    
                                   ,N_BLEND_H                           &  ! input
                                   ,N_BLEND_V                           &  !    
                                   ,N_STENCIL_H                         &  !   |
                                   ,N_STENCIL_V                         &  !   |
                                   ,N_STENCIL_SFC_H                     &  !   |
                                   ,N_STENCIL_SFC_V                     &  !   |
                                   ,ITS,ITE,JTS,JTE                     &  !   |
                                   ,IDS,IDE,JDS,JDE                     &  !   v
!                                                                            -----
                                   ,NTASKS_UPDATE_PARENT                &  !   ^
                                   ,ID_PARENT_UPDATE_TASKS              &  !   |
                                   ,NPTS_UPDATE_ON_PARENT_TASKS         &  !   |
                                   ,I_2WAY_UPDATE                       &  ! output
                                   ,J_2WAY_UPDATE                       &  !   |
                                                  )                        !   v
!
        CALLED_CHILD_2WAY_BOOKKEEPING=.TRUE.
!
!-----------------------------------------------------------------------
!***  If this child task has determined that it is responsible for
!***  updating any of its parent tasks initially or after either domain
!***  shifts then reset arrays/variables associated with the
!***  interpolation from the child to the parent.
!-----------------------------------------------------------------------
!
        reset: IF(NTASKS_UPDATE_PARENT>0)THEN                              !<-- If true then the current child task must update
!                                                                          !    at least one parent task subdomain.
!-----------------------------------------------------------------------
!
          parent_subdomains_1: DO NT=1,NTASKS_UPDATE_PARENT                !<-- Loop through each parent task subdomain to be updated.
!
!-----------------------------------------------------------------------
!
            IF(ASSOCIATED(I_2WAY_H(NT)%DATA))THEN
              DEALLOCATE(I_2WAY_H(NT)%DATA)
              DEALLOCATE(J_2WAY_H(NT)%DATA)
              DEALLOCATE(I_2WAY_V(NT)%DATA)
              DEALLOCATE(J_2WAY_V(NT)%DATA)
            ENDIF
!
            ALLOCATE(I_2WAY_H(NT)%DATA(1:NPTS_UPDATE_ON_PARENT_TASKS(NT)))
            ALLOCATE(J_2WAY_H(NT)%DATA(1:NPTS_UPDATE_ON_PARENT_TASKS(NT)))
            ALLOCATE(I_2WAY_V(NT)%DATA(1:NPTS_UPDATE_ON_PARENT_TASKS(NT)))
            ALLOCATE(J_2WAY_V(NT)%DATA(1:NPTS_UPDATE_ON_PARENT_TASKS(NT)))
!
!-----------------------------------------------------------------------
!***  Translate to this child's I's and J's the parent I's and J's to
!***  be updated.  If a child h point lies on a parent target V point
!***  (the opposite cannot happen on the B-grid) then the child's I and
!***  J are those of the child h point which corresponds to the child 
!***  v point to the NE of the parent V point.  The H-V diagrams seen in
!***  subroutines GENERATE_2WAY_DATA and PARENT_BOOKKEEPING_MOVING help
!***  clarify the relationship between h,v and H,V.
!-----------------------------------------------------------------------
!
            I_2WAY=>I_2WAY_UPDATE(NT)%DATA                                 !<-- Parent I at each parent update point on parent task NT
            J_2WAY=>J_2WAY_UPDATE(NT)%DATA                                 !<-- Parent J at each parent update point on parent task NT
!
            DO N=1,NPTS_UPDATE_ON_PARENT_TASKS(NT)                         !<-- Loop through each parent I,J to be updated on subdomain NT
!
              I_2WAY_H(NT)%DATA(N)=(I_2WAY(N)-I_SW_PARENT_CURRENT_X)    &  !<-- Child I at parent update H point
                                   *SPACE_RATIO_MY_PARENT+1                !    on parent task NT.
              J_2WAY_H(NT)%DATA(N)=(J_2WAY(N)-J_SW_PARENT_CURRENT_X)    &  !<-- Child J at parent update H point
                                   *SPACE_RATIO_MY_PARENT+1                !    on parent task NT.
!
              I_2WAY_V(NT)%DATA(N)=I_2WAY_H(NT)%DATA(N)                 &  !<-- Child I at parent update V point
                                   +SPACE_RATIO_MY_PARENT/2                !    on parent task NT.
!
              J_2WAY_V(NT)%DATA(N)=J_2WAY_H(NT)%DATA(N)                 &  !<-- Child J at parent update V point
                                   +SPACE_RATIO_MY_PARENT/2                !<-- on parent task NT.
!
            ENDDO
!
!-----------------------------------------------------------------------
!
            NTOT=NPTS_UPDATE_ON_PARENT_TASKS(NT)*NLEV_2WAY                 !<-- # of points updated for all vbls on parent task NT
!
            IF(ASSOCIATED(cc%UPDATE_PARENT_2WAY(NT)%DATA))THEN
              DEALLOCATE(cc%UPDATE_PARENT_2WAY(NT)%DATA)
            ENDIF
            ALLOCATE(cc%UPDATE_PARENT_2WAY(NT)%DATA(1:NTOT),stat=RC)       !<-- Updated values for all 2-way variables on parent task NT
!
!-----------------------------------------------------------------------
!
            NTOT_H_V=NPTS_UPDATE_ON_PARENT_TASKS(NT)*2                     !<-- # of updated H points then V points (thus *2)
            IF(ASSOCIATED(cc%CHILD_SFC_ON_PARENT(NT)%DATA))THEN
              DEALLOCATE(cc%CHILD_SFC_ON_PARENT(NT)%DATA)
            ENDIF
            ALLOCATE(cc%CHILD_SFC_ON_PARENT(NT)%DATA(1:NTOT_H_V,1:2))      !<-- Child FIS(:1),PD(:2) interp'd to H and V parent update pts
!
            NTOT_SFC=2*NTOT_H_V                                            !<-- Both FIS and PD (thus *2) are interpolated from the child
!                                                                          !    to parent H and V.
!-----------------------------------------------------------------------
!
          ENDDO parent_subdomains_1
!
!-----------------------------------------------------------------------
!
        ENDIF reset
!
!-----------------------------------------------------------------------
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  If this child task is responsible for updating none of its
!***  parent's task subdomains then it may leave.
!-----------------------------------------------------------------------
!
      IF(NTASKS_UPDATE_PARENT==0)THEN
        RETURN                                                             !<-- Nothing more to do if no parent tasks are updated
      ENDIF
!
!-----------------------------------------------------------------------
!***  The child tasks generate 2-way update data for those points on
!***  each parent task for which they are responsible.
!-----------------------------------------------------------------------
!
      parent_subdomains_2: DO NT=1,NTASKS_UPDATE_PARENT                    !<-- Loop over the parent task subdomains this child task updates.
!
!-----------------------------------------------------------------------
!
        N2=0
        BEGIN_H=.TRUE.
        BEGIN_V=.TRUE.
!
!-----------------------------------------------------------------------
!***  Loop through the variables in the 2-way exchange.
!-----------------------------------------------------------------------
!
        vars: DO NV=1,NVARS_2WAY_UPDATE                                    !<-- Loop over all parent exchange variables updated by the child.
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Field from the Bundle of 2-way Vars"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_2WAY              &  !<-- Bundle holding the arrays for 2-way exchange
                                  ,fieldIndex =NV                       &  !<-- Index of the Field in the Bundle
                                  ,field      =HOLD_FIELD               &  !<-- Field NV in the Bundle
                                  ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Info about this 2-way Variable"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field   =HOLD_FIELD                        &  !<-- Field N_FIELD in the Bundle
                            ,dimCount=NUM_DIMS                          &  !<-- Is this Field 2-D or 3-D?
                            ,typeKind=DATATYPE                          &  !<-- Does the Field contain an integer or real array?
                            ,name    =FIELD_NAME                        &  !<-- This Field's name
                            ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Character variables cannot be used as ESMF Attributes so
!***  integers are used below to indicate whether the 2-way variable
!***  is on H or V points.  After this integer Attribute is read in
!***  translate it to a character.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract whether H or V Array from Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(field=HOLD_FIELD                       &  !<-- Get Attribute from this Field
                                ,name ='H_OR_V_INT'                     &  !<-- Name of the attribute to extract
                                ,value=H_OR_V_INT                       &  !<-- Value of the Attribute
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(H_OR_V_INT==1)THEN
            H_OR_V='H'
          ELSEIF(H_OR_V_INT==2)THEN
            H_OR_V='V'
          ENDIF
!
!-----------------------------------------------------------------------
!***  Point at the child I,J points used for interpolation to the
!***  appropriate parent tasks' H and V points.
!-----------------------------------------------------------------------
!
          IF(H_OR_V=='H')THEN
            I_2WAY_X=>I_2WAY_H(NT)%DATA                                    !<-- Use child I's at parent H points
            J_2WAY_X=>J_2WAY_H(NT)%DATA                                    !<-- Use child J's at parent H points
            N_STENCIL=N_STENCIL_H                                          !<-- Width of stencil of child averaging for parent H pts
!
          ELSEIF(H_OR_V=='V')THEN
            I_2WAY_X=>I_2WAY_V(NT)%DATA                                    !<-- Use child I's at parent V points
            J_2WAY_X=>J_2WAY_V(NT)%DATA                                    !<-- Use child J's at parent V points
            N_STENCIL=N_STENCIL_V                                          !<-- Width of stencil of child averaging for parent V pts
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  The nest also interpolates its PD and sfc geopotential to parent
!***  H and V points so the parent will be able to adjust the update
!***  variables when the parent and nest surface elevations differ.
!-----------------------------------------------------------------------
!
          INTERPOLATE_SFC=.FALSE.
!
          IF(H_OR_V=='H'.AND.BEGIN_H)THEN                                  !<-- Child generates FIS,PD on H only once per vbl for parent task NT
            INTERPOLATE_SFC=.TRUE.
            N1P=1                                                          !<-- Starting word location for FIS,PD on H for parent task NT
            N2P=NPTS_UPDATE_ON_PARENT_TASKS(NT)                            !<-- Ending word location for FIS,PD on H for parent task NT
            CHILD_SFC_INTERP=>cc%CHILD_SFC_ON_PARENT(NT)%DATA(N1P:N2P,1:2) !<-- Child's FIS,PD on parent task NT's update H points
            N_STENCIL_SFC=N_STENCIL_SFC_H                                  !<-- Stencil width for interpolating child FIS,PD to parent H
!
          ELSEIF(H_OR_V=='V'.AND.BEGIN_V)THEN                              !<-- Child generates FIS,PD on V only once per vbl for parent task NT
            INTERPOLATE_SFC=.TRUE.
            N1P=NPTS_UPDATE_ON_PARENT_TASKS(NT)+1                          !<-- Starting word location for FIS,PD on V for parent task NT
            N2P=N1P+NPTS_UPDATE_ON_PARENT_TASKS(NT)-1                      !<-- Ending word location for FIS,PD on V for parent task NT
            CHILD_SFC_INTERP=>cc%CHILD_SFC_ON_PARENT(NT)%DATA(N1P:N2P,1:2) !<-- Child's FIS,PD on parent task NT's update V points
            N_STENCIL_SFC=N_STENCIL_SFC_V                                  !<-- Stencil width for interpolating child FIS,PD to parent V
!
          ENDIF
!
!-----------------------------------------------------------------------
!
          dtype: IF(DATATYPE==ESMF_TYPEKIND_R4)THEN                        !<-- Is this a Real 2-way variable?
!
!-----------------------------------------------------------------------
!
            ndims: IF(NUM_DIMS==2)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              MESSAGE_CHECK="Extract 2-way Real 2-D Array from the Field"
!             CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              CALL ESMF_FieldGet(field    =HOLD_FIELD                   &  !<-- Field that holds the 2-D data pointer
                                ,localDe  =0                            &
                                ,farrayPtr=ARRAY_2WAY_R2D               &  !<-- Use this 2-D pointer to the variable.
                                ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              L1=1
              L2=1
              NVERT=1
!
              LBND=LBOUND(ARRAY_2WAY_R2D)
              LB1=LBND(1)
              LB2=LBND(2)
              UBND=UBOUND(ARRAY_2WAY_R2D)
              UB1=UBND(1)
              UB2=UBND(2)
!
              ALLOCATE(VAR_CHILD(LB1:UB1,LB2:UB2,1))
              DO NY=LB2,UB2
              DO NX=LB1,UB1
                VAR_CHILD(NX,NY,1)=ARRAY_2WAY_R2D(NX,NY)                   !<-- For simplicity the generic exchange input is always 3-D
              ENDDO
              ENDDO
!
!-----------------------------------------------------------------------
!
            ELSEIF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              MESSAGE_CHECK="Extract 2-way Real 3-D Array from the Field"
!             CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              CALL ESMF_FieldGet(field    =HOLD_FIELD                   &  !<-- Field that holds the data pointer
                                ,localDe  =0                            &
                                ,farrayPtr=ARRAY_2WAY_R3D               &  !<-- Use this 3-D pointer to the variable.
                                ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              L1=1
              L2=1
              NVERT=LM                                                     !<-- Assume all 3-D exchange vbls have LM levels
              VAR_CHILD=>ARRAY_2WAY_R3D
!
!-----------------------------------------------------------------------
!
            ELSEIF(NUM_DIMS==4)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              MESSAGE_CHECK="Extract 2-way Real 4-D Array from the Field"
!             CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              CALL ESMF_FieldGet(field    =HOLD_FIELD                   &  !<-- Field that holds the data pointer
                                ,localDe  =0                            &
                                ,farrayPtr=ARRAY_2WAY_R4D               &  !<-- Use this 4-D pointer to the variable.
                                ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
              CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
              L1=LBOUND(ARRAY_2WAY_R4D,4)
              L2=UBOUND(ARRAY_2WAY_R4D,4)
              NVERT=LM                                                     !<-- Assume all 3-D exchange vbls have LM levels
!
!-----------------------------------------------------------------------
!
            ENDIF ndims
!
!-----------------------------------------------------------------------
!
          ELSEIF(DATATYPE==ESMF_TYPEKIND_I4)THEN
!
            WRITE(0,10001)
10001       FORMAT(' Not considering the use of Integer 2-way exchange variables')
            WRITE(0,*)' ABORT!!'
            CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
!
!-----------------------------------------------------------------------
!
          ENDIF dtype
!
!-----------------------------------------------------------------------
!
          DO NL=L1,L2                                                      !<-- Loop through this variable's 4th dimension if it exists.
!
            IF(NUM_DIMS==4)THEN
              VAR_CHILD=>ARRAY_2WAY_R4D(:,:,:,NL)                          !<-- Select the NL'th 3-D piece of the 4-D exchange variable
            ENDIF
!
            N1=N2+1                                                        !<-- Starting word location of Real vbl #NV to parent task NT
            N2=N1+NPTS_UPDATE_ON_PARENT_TASKS(NT)*NVERT-1                  !<-- Ending word location of Real vbl #NV to parent task NT
            VAR_PARENT=>cc%UPDATE_PARENT_2WAY(NT)%DATA(N1:N2)              !<-- Updated values for Real variable #NV on parent task NT
!
            CALL GENERATE_2WAY_DATA(VAR_CHILD                           &  !<-- Child variable to be interpolated
                                   ,PD                                  &  !<-- The child's PD array
                                   ,FIS                                 &  !<-- The child's sfc geopotential array
                                   ,IMS,IME,JMS,JME,NVERT               &  !<-- This child task subdomain's memory dimensions
                                   ,I_2WAY_X                            &  !<-- Child I at each parent update point (H or V)
                                   ,J_2WAY_X                            &  !<-- Child J at each parent update point (H or V)
                                   ,N_STENCIL                           &  !<-- Stencil width of child averaging for parent variable
                                   ,N_STENCIL_SFC                       &  !<-- Stencil width of child averaging its FIS,PD to parent grid
                                   ,NPTS_UPDATE_ON_PARENT_TASKS(NT)     &  !<-- # of update points (I,J) on parent task NT
                                   ,VAR_PARENT                          &  !<-- Child values interpolated onto parent points for this vbl
                                   ,INTERPOLATE_SFC                     &  !<-- Should PD and FIS be interpolated in this call?
                                   ,CHILD_SFC_INTERP                    &  !<-- Child PD,FIS interpolated onto parent H then V points
                                                      )
          ENDDO
!
          IF(BEGIN_H)THEN
            BEGIN_H=.FALSE.
          ENDIF
          IF(BEGIN_V)THEN
            BEGIN_V=.FALSE.
          ENDIF
!
          IF(NUM_DIMS==2)THEN                                              !<-- VAR_CHILD explicitly allocated only for 2-D variables
            DEALLOCATE(VAR_CHILD)
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDDO vars
!
!-----------------------------------------------------------------------
!***  The child task ISSends parent fcst task NT its update data for
!***  all the relevant variables at once followed by another ISSend
!***  of the child's FIS and PD values interpolated to the parent's 
!***  H and V points to be updated.
!-----------------------------------------------------------------------
!
        NTOT=NLEV_2WAY*NPTS_UPDATE_ON_PARENT_TASKS(NT)                     !<-- # of points (3-D) updated for all vbls on parent task NT
        NTAG=100*MY_DOMAIN_ID+MYPE
!
        CALL MPI_ISSEND(cc%UPDATE_PARENT_2WAY(NT)%DATA                  &  !<-- All variables at parent task NT's 2-way update points
                       ,NTOT                                            &  !<-- # of words sent to parent task to update 3-D variables
                       ,MPI_REAL                                        &  !<-- The words are real
                       ,ID_PARENT_UPDATE_TASKS(NT)                      &  !<-- Local ID of target parent task in P-C intracomm
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between child and parent
                       ,HANDLE_SEND_2WAY_DATA(NT)                       &  !<-- Request handle for ISend
                       ,IERR )
!
        NTOT_H_V=NPTS_UPDATE_ON_PARENT_TASKS(NT)*2                         !<-- # of updated H points then V points (thus *2)
        NTOT_SFC=2*NTOT_H_V                                                !<-- # of updated FIS and PD values updated (thus *2)
        NTAG=100*MY_DOMAIN_ID+MYPE
!
        CALL MPI_ISSEND(cc%CHILD_SFC_ON_PARENT(NT)%DATA                 &  !<-- Child FIS,PD on H,V update points of parent task NT
                       ,NTOT_SFC                                        &  !<-- # of words sent to parent task to update FIS,PD
                       ,MPI_REAL                                        &  !<-- The words are real
                       ,ID_PARENT_UPDATE_TASKS(NT)                      &  !<-- Local ID of parent task in P-C intracomm
                       ,NTAG                                            &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between child and parent
                       ,HANDLE_SEND_2WAY_SFC(NT)                        &  !<-- Request handle for ISend
                       ,IERR )
!
!-----------------------------------------------------------------------
!
      ENDDO parent_subdomains_2
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHILDREN_SEND_PARENTS_2WAY_DATA
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_CPL_FINALIZE(CPL_COMP                     &
                                          ,IMP_STATE                    &
                                          ,EXP_STATE                    &
                                          ,CLOCK                        &
                                          ,RC_FINAL)
!
!-----------------------------------------------------------------------
!***  FINALIZE THE COUPLER.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_CplComp) :: CPL_COMP                                       !<-- The Parent-Child Coupler Component
!
      TYPE(ESMF_State) :: IMP_STATE                                     &  !<-- The Coupler's Import State
                         ,EXP_STATE                                        !<-- The Coupler's Export State
!
      TYPE(ESMF_Clock) :: CLOCK                                            !<-- The ESMF Clock
!
      INTEGER,INTENT(OUT) :: RC_FINAL
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: MY_DOMAIN_ID,RC,RC_CPL_FINAL
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RC          =ESMF_SUCCESS
      RC_FINAL    =ESMF_SUCCESS
      RC_CPL_FINAL=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  Extract the domain ID.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Finalize: Extract Current Domain ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=IMP_STATE                            &  !<-- The parent-child coupler import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Name of the attribute to extract
                            ,value=MY_DOMAIN_ID                         &  !<-- Current domain's ID
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CPL_FINAL)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!
      WRITE(0,*)' Clocktime Parent-Child Coupler'
      WRITE(0,*)'   Cpl1 Prelim=',cpl1_prelim_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_H=',cpl1_south_h_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_V=',cpl1_south_v_tim*1.e-3
      WRITE(0,*)'   Cpl1 North_H=',cpl1_north_h_tim*1.e-3
      WRITE(0,*)'   Cpl1 North_V=',cpl1_north_v_tim*1.e-3
      WRITE(0,*)'   Cpl1 West_H=',cpl1_west_h_tim*1.e-3
      WRITE(0,*)'   Cpl1 West_V=',cpl1_west_v_tim*1.e-3
      WRITE(0,*)'   Cpl1 East_H=',cpl1_east_h_tim*1.e-3
      WRITE(0,*)'   Cpl1 East_V=',cpl1_east_v_tim*1.e-3
      WRITE(0,*)' '
      WRITE(0,*)'   Cpl1 South_H_Recv=',cpl1_south_h_recv_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_H_Undo=',cpl1_south_h_undo_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_H_Exp =',cpl1_south_h_exp_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_V_Recv=',cpl1_south_v_recv_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_V_Undo=',cpl1_south_v_undo_tim*1.e-3
      WRITE(0,*)'   Cpl1 South_V_Exp =',cpl1_south_v_exp_tim*1.e-3
      WRITE(0,*)' '
!
!-----------------------------------------------------------------------
!
      IF(I_AM_A_PARENT)THEN
        WRITE(0,*)'   Cpl2 Parent Bookkeeping for Moving Nest='         &
                  ,parent_bookkeep_moving_tim*1.e-3
        WRITE(0,*)'   Cpl2 Parent Update for Moving Nest='              &
                  ,parent_update_moving_tim*1.e-3
      ENDIF
      WRITE(0,*)' '
      IF(MY_DOMAIN_MOVES)THEN
        WRITE(0,*)'   Cpl1 Moving Nest Bookkeeping='                    &
                  ,parent_bookkeep_moving_tim*1.e-3
        WRITE(0,*)'   Cpl1 Moving Nest Update='                         &
                  ,parent_update_moving_tim*1.e-3
      ENDIF
! 
!-----------------------------------------------------------------------
!
      IF(RC_CPL_FINAL==ESMF_SUCCESS)THEN
!       WRITE(0,*)"CPL FINALIZE STEP SUCCEEDED"
      ELSE
        WRITE(0,*)"CPL FINALIZE STEP FAILED"
      ENDIF
!
      RC_FINAL=RC_CPL_FINAL
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_CPL_FINALIZE
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_COUPLER_SETUP(NUM_DOMAINS                 &  !      
                                           ,MY_DOMAIN_ID                &  !      
                                           ,NUM_CHILDREN                &  !      
                                           ,COMM_TO_MY_CHILDREN         &  !      
                                           ,COMM_TO_MY_PARENT           &  !      
                                           ,DT                          &  !
                                           ,CHILD_ID                    &  !     ^
                                           ,DOMAIN_GRID_COMP            &  !     |
                                           ,EXP_STATE_DOMAIN            &  !     |
                                           ,FTASKS_DOMAIN               &  !     |  
                                           ,NTASKS_DOMAIN               &  !     |  
                                           ,ID_PARENTS_IN               &  !     |   
                                           ,DOMAIN_ID_TO_RANK           &  !     |   
                                           ,MAX_DOMAINS                 &  !   Input
!                                                                           -----------
                                           ,IMP_STATE_CPL_NEST          &  !   Output
                                           ,EXP_STATE_CPL_NEST          &  !     |
                                              )                            !     v
!
!-----------------------------------------------------------------------
!***  Create the Parent-Child coupler through which they will
!***  communicate.  This coupler is called by the NMM component.
!***  Move data from the DOMAIN export state into the Parent-Child
!***  coupler import state that the coupler will need in order for
!***  parents to generate data for their children and for moving
!***  nests to determine when to move.
!-----------------------------------------------------------------------
!
      USE module_DOMAIN_INTERNAL_STATE,ONLY: DOMAIN_INTERNAL_STATE      &
                                            ,WRAP_DOMAIN_INTERNAL_STATE 
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: COMM_TO_MY_PARENT                &  !<-- Current domain's MPI communicator to its parent
                                      ,MAX_DOMAINS                      &  !<-- Maximum # of domains 
                                      ,MY_DOMAIN_ID                     &  !<-- ID of current domain
                                      ,NUM_CHILDREN                     &  !<-- Current domain's number of children
                                      ,NUM_DOMAINS                         !<-- Total number of domains
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) :: CHILD_ID             &  !<-- Domain IDs of current domain's children
                                                           ,COMM_TO_MY_CHILDREN  &  !<-- Current domain's MPI communicators to its children
                                                           ,FTASKS_DOMAIN        &  !<-- # of forecast tasks on each domain
                                                           ,ID_PARENTS_IN        &  !<-- IDs of parents of nested domains
                                                           ,NTASKS_DOMAIN           !<-- # of fcst+quilt tasks on each domain
!
      INTEGER(kind=KINT),DIMENSION(MAX_DOMAINS),INTENT(IN) :: DOMAIN_ID_TO_RANK  !<-- Configure file associated with each domain ID
!
      REAL(kind=KFPT),DIMENSION(1:NUM_DOMAINS),INTENT(IN) :: DT            !<-- Timesteps for all domains (DOMAIN Components)
!
      TYPE(ESMF_GridComp) :: DOMAIN_GRID_COMP                              !<-- The current DOMAIN component
!
      TYPE(ESMF_State),INTENT(INOUT) :: EXP_STATE_DOMAIN                   !<-- Export state of the current DOMAIN Component
!
      TYPE(ESMF_State),INTENT(INOUT) :: IMP_STATE_CPL_NEST              &  !<-- Parent-Child Coupler import state
                                       ,EXP_STATE_CPL_NEST                 !<-- Parent-Child Coupler export state
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT),SAVE :: N8=8
!
      INTEGER(kind=KINT) :: CHILDTASK                                   &
                           ,COMM_FCST_TASKS                             &
                           ,COMM_MY_DOMAIN                              &
                           ,ITS,ITE,JTS,JTE                             &
                           ,IDS,IDE,JDS,JDE                             &
                           ,ID,ID_CHILD,IERR                            &
                           ,IHANDLE_RECV,IHANDLE_SEND                   &
                           ,INDX_CW,INDX_Q                              &
                           ,I_PAR_STA,J_PAR_STA                         &
                           ,JM                                          &
                           ,LAST_STEP_MOVED                             &
                           ,KOUNT,LM,LMP1,MYPE,MYPE_DOMAIN              &
                           ,N,N_BLEND_H,N_BLEND_V,NHALO                 &
                           ,NKOUNT,NN,NPHS,NTAG,NX
!
      INTEGER(kind=KINT) :: ISTAT,RC,RC_NESTSET
!
      INTEGER(kind=KINT),DIMENSION(2) :: STORM_CENTER
!
      INTEGER(kind=KINT),DIMENSION(4) :: LIMITS
!
      INTEGER(kind=KINT),DIMENSION(8) :: MY_NEB
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER(kind=KINT),DIMENSION(:),ALLOCATABLE :: PARENT_CHILD_RATIO
!
!
      REAL(kind=KFPT) :: DLMD,DPHD,DYH,PDTOP,PT
!
      REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: ARRAY_1D
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
      TYPE(ESMF_VM) :: VM_DOMAIN
!
      LOGICAL(kind=KLOG) :: I_AM_ACTIVE,RESTART
!
      LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE :: CHILD_ACTIVE
!
      TYPE(WRAP_DOMAIN_INTERNAL_STATE) :: WRAP_DOMAIN
!
      TYPE(DOMAIN_INTERNAL_STATE),POINTER :: DOMAIN_INT_STATE
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RC        =ESMF_SUCCESS
      RC_NESTSET=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  Allocate the coupler's composite object to the total # of domains
!***  for generality.  Use the specific domain ID to access only that 
!***  part of the object that is pertinent to the given domain.  This
!***  is needed because any MPI task can be on more than one domain
!***  and it must know which domain's variables to use.
!-----------------------------------------------------------------------
!
      IF(.NOT.ASSOCIATED(CPL_COMPOSITE))THEN
        ALLOCATE(CPL_COMPOSITE(1:NUM_DOMAINS),stat=ISTAT)
!
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Parent-Child composite object already allocated!'
          WRITE(0,*)' ABORTING!'
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
      ENDIF
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  From the DOMAIN export state find out if this task is a forecast
!***  task and if it is on a parent domain.  Set them into the Parent-
!***  Child coupler's export state s they are available.
!-----------------------------------------------------------------------
!
      I_AM_A_FCST_TASK=>cc%I_AM_A_FCST_TASK
      I_AM_A_PARENT   =>cc%I_AM_A_PARENT
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Parent-Child CPL Setup: Extract Fcst-or-Write Flag from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='Fcst-or-Write Flag'                 &  !<-- Name of the attribute to extract
                            ,value=I_AM_A_FCST_TASK                     &  !<-- Am I a forecast task?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Parent/Not-a-Parent Flag from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='I-Am-A-Parent Flag'                 &  !<-- Name of the attribute to extract
                            ,value=I_AM_A_PARENT                        &  !<-- Am I on a nested domain?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Parent-Child CPL Setup: Insert Fcst-or-Write Flag into Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE_CPL_NEST                   &  !<-- The P-C coupler export state
                            ,name ='Fcst-or-Write Flag'                 &  !<-- Name of the attribute to extract
                            ,value=I_AM_A_FCST_TASK                     &  !<-- Am I a forecast task?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Parent/Not-a-Parent Flag into Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=EXP_STATE_CPL_NEST                   &  !<-- The P-C coupler export state
                            ,name ='I-Am-A-Parent Flag'                 &  !<-- Name of the attribute to extract
                            ,value=I_AM_A_PARENT                        &  !<-- Am I on a nested domain?
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------
!***  Current Domain's ID 
!-------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Current Domain ID to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='MY_DOMAIN_ID'                       &  !<-- Current domain's ID
                            ,value=MY_DOMAIN_ID                         &  !<-- Insert this into the import state
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Retrieve this domain's VM
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Get the VM of this Domain"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_GridCompGet(gridcomp=DOMAIN_GRID_COMP                   &  !<-- The Domain Component
                           ,vm      =VM_DOMAIN                          &  !<-- This domain's VM
                           ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Now load key variables into the coupler's import state.
!-----------------------------------------------------------------------
!
!---------------------------------------------------
!***  The task's local rank in the Domain component
!---------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C Cpl Setup: Obtain the Local Task ID"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_VMGet(vm      =VM_DOMAIN                                &  !<-- The virtual machine for this Domain component
                     ,localpet=MYPE_DOMAIN                              &  !<-- Each MPI task rank in the Domain component
                     ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Local Task Rank on Domain to P-C Cpl Imp State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='MYPE_DOMAIN'                        &  !<-- Local rank in Domain component
                            ,value=MYPE_DOMAIN                          &  !<-- Insert this into the import state
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------
!***  Maximum number of domains
!-------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Max # of Domains to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='MAX_DOMAINS'                        &  !<-- Maximum # of domains
                            ,value=MAX_DOMAINS                          &  !<-- Insert this into the import state
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------
!***  Total Number of Domains
!-----------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Number of Domains to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NUM_DOMAINS'                        &  !<-- Total number of domains
                            ,value=NUM_DOMAINS                          &  !<-- Insert this into the import state
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------------------------------
!***  The association of domains and their configure files
!----------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Domain/ConfigFile Association to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='DOMAIN_ID_TO_RANK'              &  !<-- The association of domains and their config files
                            ,itemCount=MAX_DOMAINS                      &  !<-- Maximum # of domains
                            ,valueList=DOMAIN_ID_TO_RANK                &  !<-- Insert this into the import state
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------------------
!***  Total Number of Tasks on Domains
!--------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Total Number of Tasks Per Domain to the P-C Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='NTASKS_DOMAIN'                  &  !<-- Number of fcst+quilt tasks on each domain
                            ,itemCount=NUM_DOMAINS                      &  !<-- Number of domains
                            ,valueList=NTASKS_DOMAIN                    &  !<-- Insert this into the import state
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------------
!***  Number of Fcst Tasks on Domains
!-------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Number of Fcst Tasks Per Domain to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='FTASKS_DOMAIN'                  &  !<-- Number of forecast tasks on each domain
                            ,itemCount=NUM_DOMAINS                      &  !<-- Number of domains
                            ,valueList=FTASKS_DOMAIN                    &  !<-- Insert this into the import state
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------------
!***  Fundamental Timestep on Domains
!-------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Number of Fcst Tasks Per Domain to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='DOMAIN_DTs'                     &  !<-- Number of forecast tasks on each domain
                            ,itemCount=NUM_DOMAINS                      &  !<-- Number of domains
                            ,valueList=DT                               &  !<-- Insert this into the import state
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------------
!***  Domain IDs of Parents
!---------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Domain IDs of Parents to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='ID_PARENTS'                     &  !<-- IDs of parent domain
                            ,itemCount=NUM_DOMAINS                      &  !<-- Number of domains
                            ,valueList=ID_PARENTS_IN                    &  !<-- Insert this into the import state
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------
!***  Number of Children
!------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Number of Children to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NUM_CHILDREN'                       &  !<-- This DOMAIN component's # of children
                            ,value=NUM_CHILDREN                         &  !<-- Insert this into the import state
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------
!***  Communicators to Children
!-------------------------------
!
      IF(NUM_CHILDREN>0)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Parent-to-Child Communicators to the Parent-Child CPL Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='Parent-to-Child Comms'        &  !<-- Name of Attribute
                              ,itemCount=NUM_CHILDREN                   &  !<-- Length of inserted array
                              ,valueList=COMM_TO_MY_CHILDREN            &  !<-- Communicators to my children
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF
!
!----------------------------
!***  Communicator to Parent
!----------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Child-to-Parent Communicator to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='Child-to-Parent Comm'               &  !<-- Name of Attribute
                            ,value=COMM_TO_MY_PARENT                    &  !<-- The communicator to my parent
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------
!***  Communicator for each domain
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C CPL Setup: Get the Intracommunicator of this Domain"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_VMGet(vm             =VM_DOMAIN                         &  !<-- This domain's VM
                     ,mpiCommunicator=COMM_MY_DOMAIN                    &  !<-- This domain's intracommunicator
                     ,rc             =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------------------------------------
!***  The intracommunicator for forecast tasks on this domain
!-------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="P-C CPL Setup: Extract Fcst Task Intracomm from Domain Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of the attribute to extract
                            ,value=COMM_FCST_TASKS                      &  !<-- Intracomm for fcst task on this domain
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add COMM_FCST_TASKS to Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='Comm Fcst Tasks'                    &  !<-- Name of Attribute
                            ,value=COMM_FCST_TASKS                      &  !<-- Intracomm for fcst task on this domain
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------
!***  Number of fcst tasks on this domain
!-----------------------------------------
!
      NUM_PES_FCST=>cc%NUM_PES_FCST
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add NUM_PES_FCST to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NUM_PES_FCST'                       &  !<-- The name of the Attribute 
                            ,value=NUM_PES_FCST                         &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NUM_PES_FCST'                       &  !<-- Name of Attribute
                            ,value=NUM_PES_FCST                         &  !<-- The # of fcst tasks on this domain
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  The write/quilt tasks are no longer needed.
!-----------------------------------------------------------------------
!
      IF(.NOT.I_AM_A_FCST_TASK)RETURN
!
!-----------------------------------------------------------------------
!
!--------------------------------------------------------
!***  Subdomain integration limits on the forecast tasks
!--------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Integration Limits from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='ITS'                                &  !<-- The name of the Attribute 
                            ,value=ITS                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='ITE'                                &  !<-- The name of the Attribute
                            ,value=ITE                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='JTS'                                &  !<-- The name of the Attribute
                            ,value=JTS                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='JTE'                                &  !<-- The name of the Attribute
                            ,value=JTE                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='LM'                                 &  !<-- The name of the Attribute
                            ,value=LM                                   &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NHALO'                              &  !<-- The name of the Attribute
                            ,value=NHALO                                &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Subdomain Integration Limits to the P-C Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='ITS'                                &  !<-- The name of the Attribute
                            ,value=ITS                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='ITE'                                &  !<-- The name of the Attribute
                            ,value=ITE                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='JTS'                                &  !<-- The name of the Attribute
                            ,value=JTS                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='JTE'                                &  !<-- The name of the Attribute
                            ,value=JTE                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='LM'                                 &  !<-- The name of the Attribute
                            ,value=LM                                   &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NHALO'                              &  !<-- The name of the Attribute
                            ,value=NHALO                                &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------------------------------------------
!***  Subdomain integration limits for all fcst tasks on my domain 
!------------------------------------------------------------------
!
!
      CALL ESMF_GridCompGetInternalState(DOMAIN_GRID_COMP               &  !<-- The DOMAIN component
                                        ,WRAP_DOMAIN                    &  !<-- Extract the pointer to my DOMAIN internal state
                                        ,RC )
!
      DOMAIN_INT_STATE=>wrap_domain%DOMAIN_INT_STATE                       !<-- Point at my DOMAIN internal state
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add All Fcst Task Integration Limits to the P-C Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='LOCAL ISTART'                   &  !<-- Name of Attribute
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- Length of inserted array (# of fcst tasks on domain)
                            ,valueList=domain_int_state%LOCAL_ISTART    &  !<-- Starting I's on my domain's fcst tasks
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='LOCAL IEND'                     &  !<-- Name of Attribute
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- Length of inserted array (# of fcst tasks on domain)
                            ,valueList=domain_int_state%LOCAL_IEND      &  !<-- Ending I's on my domain's fcst tasks
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='LOCAL JSTART'                   &  !<-- Name of Attribute
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- Length of inserted array (# of fcst tasks on domain)
                            ,valueList=domain_int_state%LOCAL_JSTART    &  !<-- Starting J's on my domain's fcst tasks
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='LOCAL JEND'                     &  !<-- Name of Attribute
                            ,itemCount=FTASKS_DOMAIN(MY_DOMAIN_ID)      &  !<-- Length of inserted array (# of fcst tasks on domain)
                            ,valueList=domain_int_state%LOCAL_JEND      &  !<-- Ending J's on my domain's fcst tasks
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------
!***  Full Domain Dimensions
!----------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Full Domain Dimensions from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='IDS'                                &  !<-- The name of the Attribute 
                            ,value=IDS                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='IDE'                                &  !<-- The name of the Attribute 
                            ,value=IDE                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='JDS'                                &  !<-- The name of the Attribute 
                            ,value=JDS                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='JDE'                                &  !<-- The name of the Attribute 
                            ,value=JDE                                  &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Full Domain Dimensions to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='IDS'                                &  !<-- The name of the Attribute
                            ,value=IDS                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='IDE'                                &  !<-- The name of the Attribute
                            ,value=IDE                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='JDS'                                &  !<-- The name of the Attribute
                            ,value=JDS                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='JDE'                                &  !<-- The name of the Attribute
                            ,value=JDE                                  &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  My 8 neighboring tasks.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract MY_NEB from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='MY_NEB'                             &  !<-- The name of the Attribute 
                            ,itemCount=N8                               &  !<-- # of words in data list
                            ,valueList=MY_NEB                           &  !<-- Put extracted values here 
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add MY_NEB to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='MY_NEB'                             &  !<-- The name of the Attribute
                            ,itemCount=N8                               &  !<-- # of words in data list
                            ,valueList=MY_NEB                           &  !<-- Put added values here 
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------------
!***  Frequency of physics calls
!--------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract NPHS from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NPHS'                               &  !<-- The name of the Attribute 
                            ,value=NPHS                                 &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add NPHS to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NPHS'                               &  !<-- The name of the Attribute
                            ,value=NPHS                                 &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------------------------
!***  Width of Boundary Blending Region
!---------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Boundary Blending Region Widths from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='LNSH'                               &  !<-- The name of the Attribute 
                            ,value=N_BLEND_H                            &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='LNSV'                               &  !<-- The name of the Attribute
                            ,value=N_BLEND_V                            &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Boundary Blending Region Widths to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='N_BLEND_H'                          &  !<-- The name of the Attribute
                            ,value=N_BLEND_H                            &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='N_BLEND_V'                          &  !<-- The name of the Attribute
                            ,value=N_BLEND_V                            &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------------
!***  Transfer SW Corner of Nest
!--------------------------------
!
      nests_only: IF(ID_PARENTS_IN(MY_DOMAIN_ID)>0)THEN                    !<-- If so, this domain is a nest.
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract SW Corner of Nest from DOMAIN Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='I_PAR_STA'                        &  !<-- The name of the Attribute
                              ,value=I_PAR_STA                          &  !<-- The Attribute to be retrieved
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='J_PAR_STA'                        &  !<-- The name of the Attribute
                              ,value=J_PAR_STA                          &  !<-- The Attribute to be retrieved
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add SW Corner of Nest to the Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                              ,name ='I_PAR_STA'                        &  !<-- The name of the Attribute
                              ,value=I_PAR_STA                          &  !<-- The Attribute to be inserted
                              ,rc   =RC)
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                              ,name ='J_PAR_STA'                        &  !<-- The name of the Attribute
                              ,value=J_PAR_STA                          &  !<-- The Attribute to be inserted
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------
!***  Transfer the domain's storm center.
!-----------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Storm Center of Nest from DOMAIN Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN               &  !<-- The DOMAIN export state
                              ,name     ='Storm Center'                 &  !<-- The name of the Attribute
                              ,valueList=STORM_CENTER                   &  !<-- The Attribute to be retrieved
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Storm Center of Nest to the Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='Storm Center'                 &  !<-- The name of the Attribute
                              ,itemCount=2                              &  !<-- The # of words in the Attribute
                              ,valueList=STORM_CENTER                   &  !<-- The Attribute to be inserted
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------
!***  Transfer the domain's last move timestep.
!-----------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Last Move Timestep from DOMAIN Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='LAST_STEP_MOVED'                  &  !<-- The name of the Attribute
                              ,value=LAST_STEP_MOVED                    &  !<-- The Attribute to be retrieved
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Next Move Timestep to the Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                              ,name ='LAST_STEP_MOVED'                  &  !<-- The name of the Attribute
                              ,value=LAST_STEP_MOVED                    &  !<-- The Attribute to be inserted
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------
!***  Transfer the domain's next move timestep.
!-----------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Next Move Timestep from DOMAIN Export State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='NEXT_MOVE_TIMESTEP'               &  !<-- The name of the Attribute
                              ,value=cc%NEXT_MOVE_TIMESTEP              &  !<-- The Attribute to be retrieved
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Next Move Timestep to the Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                              ,name ='NEXT_MOVE_TIMESTEP'               &  !<-- The name of the Attribute
                              ,value=cc%NEXT_MOVE_TIMESTEP              &  !<-- The Attribute to be inserted
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Cpl Setup: Extract NTRACK storm flag from Domain exp state."                     
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &   !<-- The DOMAIN export state 
                              ,name ='NTRACK'                           &   !<-- The name of the Attribute
                              ,value=cc%NTRACK                          &   !<-- The Attribute to be retrieved 
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="P-C Cpl Setup: Insert NTRACK storm flag into P-C Cpl imp state."                 
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                              ,name ='NTRACK'                           &  !<-- The name of the Attribute 
                              ,value=cc%NTRACK                          &  !<-- The Attribute to be inserted 
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF nests_only
!
!---------------------------
!***  Transfer restart flag
!---------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Restart Flag from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='RESTART'                            &  !<-- The name of the Attribute
                            ,value=RESTART                              &  !<-- The Attribute to be retrieved
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Add Restart Flag to the Parent-Child Cpl Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='RESTART'                            &  !<-- The name of the Attribute
                            ,value=RESTART                              &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------
!***  Transfer Sfc Geopotential
!-------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract FIS from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='FIS'                                 &  !<-- Extract FIS Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert FIS into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------
!***  Transfer geographic latitude
!----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLAT from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='GLAT'                                &  !<-- Extract GLAT Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert GLAT into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------
!***  Transfer geographic longitude
!-----------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract GLON from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='GLON'                                &  !<-- Extract GLON Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert GLON into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------------------------------------
!***  Transfer PT,PDTOP,PSGML1,SG1,SG2,SGML2,DSG2,PDSG1
!-------------------------------------------------------
!
      LMP1=LM+1
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PT from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='PT'                                 &  !<-- Extract PT
                            ,value=PT                                   &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='PT'                                 &  !<-- Insert PT
                            ,value=PT                                   &  !<-- Insert this value
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='PDTOP'                              &  !<-- Extract PDTOP
                            ,value=PDTOP                                &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='PDTOP'                              &  !<-- Insert PDTOP
                            ,value=PDTOP                                &  !<-- Insert this value
                            ,rc   =RC)
!
      ALLOCATE(ARRAY_1D(1:LM))
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='PSGML1'                         &  !<-- Extract PGMSL1
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here 
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='PSGML1'                         &  !<-- Insert PGMSL1
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='SGML2'                          &  !<-- Extract SGML2
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='SGML2'                          &  !<-- Insert SGML2
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='DSG2'                           &  !<-- Extract DSG2
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='DSG2'                           &  !<-- Insert DSG2
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='PDSG1'                          &  !<-- Extract PDSG1
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='PDSG1'                          &  !<-- Insert PDSG1
                            ,itemCount=LM                               &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
      DEALLOCATE(ARRAY_1D)
!
      ALLOCATE(ARRAY_1D(1:LMP1))
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='SG1'                            &  !<-- Extract SG1
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='SG1'                            &  !<-- Insert SG1
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='SG2'                            &  !<-- Extract SG2
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='SG2'                            &  !<-- Insert SG2
                            ,itemCount=LMP1                             &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      DEALLOCATE(ARRAY_1D)
!
!------------------------
!***  Transfer DY and DX
!------------------------
!
      NKOUNT=JDE-JDS+1
      ALLOCATE(ARRAY_1D(1:NKOUNT))
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DY,DX from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='DYH'                                &  !<-- Extract DYH
                            ,value=DYH                                  &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='DYH'                                &  !<-- Insert DYH
                            ,value=DYH                                  &  !<-- Insert this value
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                            ,name     ='DXH'                            &  !<-- Extract DXH
                            ,itemCount=NKOUNT                           &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Put extracted values here
                            ,rc       =RC)
!
      CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST               &  !<-- The Parent-Child Coupler's import state
                            ,name     ='DXH'                            &  !<-- Insert DXH
                            ,itemCount=NKOUNT                           &  !<-- # of words in data list
                            ,valueList=ARRAY_1D                         &  !<-- Insert these values
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      DEALLOCATE(ARRAY_1D)
!
!------------------------
!***  Transfer DPHD,JM
!------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract DPHD,JM from DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='DPHD'                               &  !<-- Extract latitude grid increment (deg)
                            ,value=DPHD                                 &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='DPHD'                               &  !<-- Insert latitude grid increment (deg)
                            ,value=DPHD                                 &  !<-- Insert this value
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='DLMD'                               &  !<-- Extract longitude grid increment (deg)
                            ,value=DLMD                                 &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='DLMD'                               &  !<-- Insert longitude grid increment (deg)
                            ,value=DLMD                                 &  !<-- Insert this value
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='JM'                                 &  !<-- Extract DYH
                            ,value=JM                                   &  !<-- Put the extracted value here
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='JM'                                 &  !<-- Insert DYH
                            ,value=JM                                   &  !<-- Insert this value
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      parents_only: IF(I_AM_A_PARENT)THEN             
!
!-----------------------------------------------------------------------
!
!----------------------------------------------
!***  Ratio of Domain's Timestep to Children's
!----------------------------------------------
!
        ALLOCATE(PARENT_CHILD_RATIO(1:NUM_CHILDREN))
!
        DO N=1,NUM_CHILDREN
          PARENT_CHILD_RATIO(N)=NINT(DT(MY_DOMAIN_ID)/DT(CHILD_ID(N)))
        ENDDO
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Parent-Child DT Ratios to the Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='Parent-Child Time Ratio'      &  !<-- Name of Attribute
                              ,itemCount=NUM_CHILDREN                   &  !<-- Length of inserted array
                              ,valueList=PARENT_CHILD_RATIO             &  !<-- The communicator to my parent
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        DEALLOCATE(PARENT_CHILD_RATIO)
!
!-------------------------------
!***  The Children's Domain IDs
!-------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Add Domain IDs of Children to Parent-Child Cpl Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='CHILD_IDs'                    &  !<-- Name of Attribute
                              ,itemCount=NUM_CHILDREN                   &  !<-- Length of inserted array
                              ,valueList=CHILD_ID                       &  !<-- The children's IDs of this ATM Component
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF parents_only
!
!-----------------------------------------------------------------------
!***  Now transfer the parent's prognostic arrays from the DOMAIN export
!***  state to the Parent-Child coupler import state that will be
!***  required for the children's boundary data.
!-----------------------------------------------------------------------
!
!-----------------
!***  Transfer PD
!-----------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PD Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='PD'                                  &  !<-- Extract PD Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert PD into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------------------
!***  Transfer Layer Interface Pressures
!----------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract PINT Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='PINT'                                &  !<-- Extract PINT Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert PINT into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------
!***  Transfer Temperature
!--------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract T Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='T'                                   &  !<-- Extract T Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert T into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------
!***  Transfer U Wind
!---------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract U Wind Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='U'                                   &  !<-- Extract U Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert U into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------
!***  Transfer V Wind
!---------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract V Wind Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='V'                                   &  !<-- Extract V Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert V into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-------------------------
!***  Transfer Midlayer Z
!-------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Midlyaer Z Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='Z'                                   &  !<-- Extract midlayer Z Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Midlayer Z into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------------
!***  Transfer TRACERS Field
!----------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Tracers Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='TRACERS'                             &  !<-- Extract TRACERS Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Tracers into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------
!***  Transfer Sea Mask Field
!-----------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract SM Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='SM'                                  &  !<-- Extract Seas Mask Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert SM into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------
!***  Transfer INDX_Q
!---------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract INDX_Q from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='INDX_Q'                             &  !<-- Name of Attribute to extract
                            ,value=INDX_Q                               &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert INDX_Q into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='INDX_Q'                             &  !<-- The name of the Attribute to insert
                            ,value=INDX_Q                               &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!----------------------
!***  Transfer INDX_CW
!----------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract INDX_CW from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='INDX_CW'                            &  !<-- Name of Attribute to extract
                            ,value=INDX_CW                              &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert INDX_CW into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='INDX_CW'                            &  !<-- The name of the Attribute to insert
                            ,value=INDX_CW                              &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------
!***  Transfer INDX_WATER_END
!------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract INDX_WATER_END from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='INDX_WATER_END'                    &  !<-- Name of Attribute to extract
                            ,value=INDX_WATER_END                      &  !<-- Put the extracted Attribute here
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert INDX_WATER_END into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='INDX_WATER_END'                    &  !<-- The name of the Attribute to insert
                            ,value=INDX_WATER_END                      &  !<-- The Attribute to be inserted
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------------
!***  Transfer 10-m U wind component
!------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract U10 Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='U10'                                 &  !<-- Extract U10 Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert U10 into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!------------------------------------
!***  Transfer 10-m V wind component
!------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract V10 Field from Parent DOMAIN Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =EXP_STATE_DOMAIN                      &  !<-- The DOMAIN export state
                        ,itemName='V10'                                 &  !<-- Extract V10 Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert V10 into Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                       &  !<-- The Parent-Child Coupler's import state
                        ,(/HOLD_FIELD/)                  &  !<-- The Field to be inserted
                        ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  All parent tasks need to know the local subdomain limits of each
!***  task on their children.  
!-----------------------------------------------------------------------
!
      LIMITS(1)=ITS
      LIMITS(2)=ITE
      LIMITS(3)=JTS
      LIMITS(4)=JTE
!
!-----------------------------------------------------------------------
!***  Child tasks send their subdomain limits to parent task 0.
!-----------------------------------------------------------------------
!
      IF(COMM_TO_MY_PARENT/=-999)THEN                                      !<-- Select child tasks
        CALL MPI_COMM_RANK(COMM_TO_MY_PARENT,MYPE,IERR)                    !<-- Obtain my local rank in parent-child intracomm
        NTAG=MYPE+9999
!
        CALL MPI_SEND(LIMITS                                            &  !<-- Child task sends its subdomain limits
                      ,4                                                &  !<-- # of indices sent
                      ,MPI_INTEGER                                      &  !<-- Indices are integers
                      ,0                                                &  !<-- Indices sent to parent fcst task 0
                      ,NTAG                                             &  !<-- Unique MPI tag
                      ,COMM_TO_MY_PARENT                                &  !<-- MPI intracommunicator between parent and child
                      ,IERR)
      ENDIF
!
!-----------------------------------------------------------------------
!***  Rank 0 parent tasks recv their children's tasks' subdomain limits
!***  then send the children the integration limits of every fcst task
!***  on the parent domain.
!-----------------------------------------------------------------------
!
      ID=MY_DOMAIN_ID
!
      IF(I_AM_A_PARENT)THEN
!
        ALLOCATE(CTASK_LIMITS(ID)%CHILDREN(1:NUM_CHILDREN))
!
        ALLOCATE(HANDLE_CHILD_LIMITS(ID)%CHILDREN(1:NUM_CHILDREN))
!
        DO N=1,NUM_CHILDREN
          ID_CHILD=CHILD_ID(N)
!
          ALLOCATE(CTASK_LIMITS(ID)%CHILDREN(N)%DATA(1:4,1:FTASKS_DOMAIN(ID_CHILD)),stat=IERR)  !<-- Pointer to hold each child task's
                                                                                                !    subdomain limits
          IF(IERR/=0)WRITE(0,*)' Failed to allocate CTASK_LIMITS'
!
          CALL MPI_COMM_RANK(COMM_TO_MY_CHILDREN(N),MYPE,IERR)             !<-- Obtain the ranks of parent tasks 
!
          HANDLE_CHILD_LIMITS(ID)%CHILDREN(N)%DATA=>NULL()
!
          IF(MYPE==0)THEN
!
            ALLOCATE(HANDLE_CHILD_LIMITS(ID)%CHILDREN(N)%DATA(1:FTASKS_DOMAIN(ID_CHILD)))
!
            DO NN=1,FTASKS_DOMAIN(ID_CHILD)
              CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NN-1)   !<-- Local rank of child task NN in p-c intracomm
              NTAG=CHILDTASK+9999
              CALL MPI_IRECV(CTASK_LIMITS(ID)%CHILDREN(N)%DATA(1,NN)    &  !<-- Subdomain limits of fcst task NN on child N
                            ,4                                          &  !<-- # of index limits received
                            ,MPI_INTEGER                                &  !<-- Indices are integers
                            ,CHILDTASK                                  &  !<-- Local rank of child task NN (the sender) in p-c intracomm
                            ,NTAG                                       &  !<-- Unique MPI tag
                            ,COMM_TO_MY_CHILDREN(N)                     &  !<-- MPI communicator between parent and child N
                            ,HANDLE_CHILD_LIMITS(ID)%CHILDREN(N)%DATA(NN) &
                            ,IERR)
            ENDDO
!
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Create then transfer the object holding the domain's children's 
!***  next move timesteps if this is a restarted run.
!-----------------------------------------------------------------------
!
        ALLOCATE(cc%NTIMESTEP_CHILD_MOVES(1:NUM_DOMAINS_MAX),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate cpl_composite%NTIMESTEP_CHILD_MOVES stat=',ISTAT
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
        ENDIF
        NTIMESTEP_CHILD_MOVES=>cc%NTIMESTEP_CHILD_MOVES
!
        DO N=1,NUM_DOMAINS_MAX
          NTIMESTEP_CHILD_MOVES(N)=-999
        ENDDO
!
        IF(RESTART)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Next Move Timestep of Children from DOMAIN Export State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN             &  !<-- The DOMAIN export state
                                ,name     ='NEXT_TIMESTEP_CHILD_MOVES'  &  !<-- The name of the Attribute
                                ,valueList=NTIMESTEP_CHILD_MOVES        &  !<-- The Attribute to be retrieved
                                ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Add Next Move Timestep of Children to the Parent-Child Cpl Import State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST           &  !<-- The Parent-Child Coupler's import state
                                ,name     ='NEXT_TIMESTEP_CHILD_MOVES'  &  !<-- The name of the Attribute
                                ,itemCount=NUM_DOMAINS_MAX              &  !<-- The number of items
                                ,valueList=cc%NTIMESTEP_CHILD_MOVES     &  !<-- The Attribute to be inserted
                                ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  The Parent-Child coupler needs the pointers to the Solver
!***  internal state variables that are updated on the child 
!***  boundaries by the parents.  The Bundle holding those pointers
!***  is in the Domain component's export state.  Transfer the
!***  Bundle to the P-C coupler's import state.
!-----------------------------------------------------------------------
!
!
      get_bc_bundle: IF(I_AM_A_FCST_TASK)THEN
        BUNDLE_NESTBC=>cc%BUNDLE_NESTBC
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Bundle of Nest BC Vbls from Domain Exp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateGet(state      =EXP_STATE_DOMAIN                 &  !<-- The DOMAIN export state
                          ,itemName   ='Bundle_nestbc'                  &  !<-- Bundle of Solver internal state pointers for nest BC vbls
                          ,fieldbundle=BUNDLE_NESTBC                    &  !<-- Put the extracted Bundle here
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Insert Bundle of Nest BC Vbls into P-C Coupler Imp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                           &  !<-- The Parent-Child Coupler's import state
                          ,(/BUNDLE_NESTBC/)                   &  !<-- The Bundle of Solver int state pointers for nest BC vbls
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  The Parent-Child coupler also needs to know the # of H-pt and
!***  V-pt boundary variables.  Transfer those values.
!-----------------------------------------------------------------------
!
        NVARS_BC_2D_H=>cc%NVARS_BC_2D_H
        NVARS_BC_3D_H=>cc%NVARS_BC_3D_H
        NVARS_BC_4D_H=>cc%NVARS_BC_4D_H
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract # of H-pt Nest Bndry Vrbls from Domain Exp State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='NVARS_BC_2D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_2D_H                      &  !<-- # of 2-D H-pt boundary variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='NVARS_BC_3D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_3D_H                      &  !<-- # of 3-D H-pt boundary variables
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='NVARS_BC_4D_H'                    &  !<-- Name of Attribute to extract
                              ,value=NVARS_BC_4D_H                      &  !<-- # of 4-D H-pt boundary variables
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        NVARS_BC_2D_V=>cc%NVARS_BC_2D_V
        NVARS_BC_3D_V=>cc%NVARS_BC_3D_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract # of V-pt Nest Bndry Vrbls from Domain Exp State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NVARS_BC_2D_V'                      &  !<-- Name of Attribute to extract
                            ,value=NVARS_BC_2D_V                        &  !<-- # of 2-D V-pt boundary variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NVARS_BC_3D_V'                      &  !<-- Name of Attribute to extract
                            ,value=NVARS_BC_3D_V                        &  !<-- # of 3-D V-pt boundary variables
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        IF(NVARS_BC_4D_H==0)THEN
!
          ALLOCATE(cc%LBND_4D(1:1))
          ALLOCATE(cc%UBND_4D(1:1))
!
          cc%LBND_4D(1)=-1
          cc%UBND_4D(1)=-1
!
        ELSEIF(NVARS_BC_4D_H>0)THEN
!
          ALLOCATE(cc%LBND_4D(1:NVARS_BC_4D_H))
          ALLOCATE(cc%UBND_4D(1:NVARS_BC_4D_H))

!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Lower Bounds of 4-D Bndry Vbls from DOMAIN export state"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN             &  !<-- The DOMAIN export state
                                ,name     ='LBND_4D'                    &  !<-- Extract Attribute with this name
                                ,itemCount=NVARS_BC_4D_H                &  !<-- How many items?
                                ,valueList=cc%LBND_4D                   &  !<-- Lower bounds of 4-D H-pt bndry vbls
                                ,rc       =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Upper Bounds of 4-D Bndry Vbls from DOMAIN export state"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state    =EXP_STATE_DOMAIN             &  !<-- The DOMAIN export state
                                ,name     ='UBND_4D'                    &  !<-- Extract Attribute with this name
                                ,itemCount=NVARS_BC_4D_H                &  !<-- How many items?
                                ,valueList=cc%UBND_4D                   &  !<-- Upper bounds of 4-D H-pt bndry vbls
                                ,rc       =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        END IF

!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert # of H-pt Nest Bndry Vrbls into P-C Imp State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NVARS_BC_2D_H'                      &  !<-- The name of the Attribute to insert
                            ,value=NVARS_BC_2D_H                        &  !<-- # of 2-D H-pt boundary variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NVARS_BC_3D_H'                      &  !<-- The name of the Attribute to insert
                            ,value=NVARS_BC_3D_H                        &  !<-- # of 3-D H-pt boundary variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NVARS_BC_4D_H'                      &  !<-- The name of the Attribute to insert
                            ,value=NVARS_BC_4D_H                        &  !<-- # of 4-D H-pt boundary variables
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert # of V-pt Nest Bndry Vrbls into P-C Imp State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NVARS_BC_2D_V'                      &  !<-- The name of the Attribute to insert
                            ,value=NVARS_BC_2D_V                        &  !<-- # of 2-D H-pt boundary variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The Parent-Child Coupler's import state
                            ,name ='NVARS_BC_3D_V'                      &  !<-- The name of the Attribute to insert
                            ,value=NVARS_BC_3D_V                        &  !<-- # of 3-D H-pt boundary variables
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      IF(NVARS_BC_4D_H>0)THEN
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='LBND_4D'                      &  !<-- Name of the integer scalar
                              ,itemCount=NVARS_BC_4D_H                  &  !<-- Length of array being inserted into the import state
                              ,valuelist=cc%LBND_4D                        &  !<-- The array being inserted into the import state
                              ,rc   =RC)
        CALL ESMF_AttributeSet(state    =IMP_STATE_CPL_NEST             &  !<-- The Parent-Child Coupler's import state
                              ,name     ='UBND_4D'                      &  !<-- Name of the integer scalar
                              ,itemCount=NVARS_BC_4D_H                  &  !<-- Length of array being inserted into the import state
                              ,valuelist=cc%UBND_4D                        &  !<-- The array being inserted into the import state
                              ,rc   =RC)
      ENDIF
!
!-----------------------------------------------------------------------
!***  How many total model layers are involved with all H-pt and V-pt
!***  boundary variables?  Tansfer that information to the Parent-
!***  Child coupler for use in allocating working objects.
!-----------------------------------------------------------------------
!
      NLEV_H=>cc%NLEV_H
      NLEV_V=>cc%NLEV_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract # of Model Lyrs in all Nest Bndry Vrbls"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NLEV_H'                             &  !<-- Name of Attribute to extract
                            ,value=NLEV_H                               &  !<-- # of model layers for all H-pt BC variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                     &  !<-- The DOMAIN export state
                            ,name ='NLEV_V'                             &  !<-- Name of Attribute to extract
                            ,value=NLEV_V                               &  !<-- # of model layers for all V-pt BC variables
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Set # of Model Lyrs in all Nest Bndry Vrbls"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The P-C coupler import state
                            ,name ='NLEV_H'                             &  !<-- Name of Attribute to extract
                            ,value=NLEV_H                               &  !<-- # of model layers for all H-pt BC variables
                            ,rc   =RC)
!
      CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                   &  !<-- The P-C coupler import state
                            ,name ='NLEV_V'                             &  !<-- Name of Attribute to extract
                            ,value=NLEV_V                               &  !<-- # of model layers for all V-pt BC variables
                            ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF get_bc_bundle
!
!-----------------------------------------------------------------------
!***  If there are moving nests then their parents need the Bundles
!***  of 2-D and 3-D variables in the Solver internal state that
!***  need to be updated after the nests move.  The Bundles are
!***  unloaded from the DOMAIN export state and loaded into the
!***  Parent-Child coupler import state.  If there are no moving
!***  nests then the Bundles are empty.
!-----------------------------------------------------------------------
!
      MOVE_BUNDLE_H=>cc%MOVE_BUNDLE_H
      MOVE_BUNDLE_V=>cc%MOVE_BUNDLE_V
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Bundles for Moving Nests from Domain Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state      =EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                        ,itemName   ='Move_Bundle H'                    &  !<-- Name of Bundle of internal state H arrays
                        ,fieldbundle=MOVE_BUNDLE_H                      &  !<-- Put the extracted Bundle here
                        ,rc         =RC)
!
      CALL ESMF_StateGet(state      =EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                        ,itemName   ='Move_Bundle V'                    &  !<-- Name of Bundle of internal state V arrays
                        ,fieldbundle=MOVE_BUNDLE_V                      &  !<-- Put the extracted Bundle here
                        ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert Bundle for Moving Nests into P-C Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                        ,(/MOVE_BUNDLE_H/)         &  !<-- The Bundle of internal state H arrays to update
                        ,rc         =RC)
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                        ,(/MOVE_BUNDLE_V/)         &  !<-- The Bundle of internal state V arrays to update
                        ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  If 2-way nesting is being used then an ESMF Bundle is used
!***  to hold pointers to the Solver component's internal state
!***  variables which are interpolated by the child to its parent's
!***  grid then sent to the parent.  Unload the 2-way Bundle from
!***  the Domain component's export state and load it into the
!***  parent-Child coupler's import state.  If 2-way nesting has
!***  not been selected by the user then the 2-way Bundle is
!***  still present but is empty.
!-----------------------------------------------------------------------
!
      BUNDLE_2WAY=>cc%BUNDLE_2WAY
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract 2-way Bundle from Domain Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state      =EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                        ,itemName   ='Bundle_2way'                      &  !<-- Bundle of Solver internal state pointers for 2-way exch
                        ,fieldbundle=BUNDLE_2WAY                        &  !<-- Put the extracted Bundle here
                        ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Insert 2-way Bundle into P-C Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateAddReplace(IMP_STATE_CPL_NEST                 &  !<-- The Parent-Child Coupler's import state
                        ,(/BUNDLE_2WAY/)           &  !<-- The Bundle of Solver internal state pointers for 2-way exch
                        ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Transfer the flags indicating whether a domain and any of its
!***  children are active in the digital filtering.
!-----------------------------------------------------------------------
!
      IF(I_AM_A_FCST_TASK)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract DFI flag for this domain"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                   &  !<-- The DOMAIN export state
                              ,name ='I Am Active'                      &  !<-- Name of Attribute to extract
                              ,value=I_AM_ACTIVE                        &  !<-- Does this domain participate in digital filtering?
                              ,rc   =RC)
!
        CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                 &  !<-- The P-C coupler import state
                              ,name ='I Am Active'                      &  !<-- Name of Attribute to set.
                              ,value=I_AM_ACTIVE                        &  !<-- Does this domain participate in digital filtering?
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        IF(NUM_CHILDREN>0)THEN
          ALLOCATE(CHILD_ACTIVE(1:NUM_CHILDREN))
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract child DFI flags from Domain export state"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(state=EXP_STATE_DOMAIN                  &  !<-- The DOMAIN export state
                                ,name ='Child Active'                    &  !<-- The name of the Attribute 
!                               ,itemCount=NUM_CHILDREN                  &  !<-- # of words in data list
                                ,valueList=CHILD_ACTIVE                  &  !<-- Put extracted values here 
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Add child DFI flags to the Parent-Child Cpl Import State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeSet(state=IMP_STATE_CPL_NEST                &  !<-- The Parent-Child Coupler's import state
                                ,name ='Child Active'                    &  !<-- The name of the Attribute
                                ,itemCount=NUM_CHILDREN                  &  !<-- # of words in data list
                                ,valueList=CHILD_ACTIVE                  &  !<-- Put added values here 
                                ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_NESTSET)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          DEALLOCATE(CHILD_ACTIVE)
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_COUPLER_SETUP
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Tasks point into the Parent-Child coupler's composite object
!***  in order to access coupler variables valid for the current
!***  domain.  This is an internal subroutine of
!***  PARENT_CHILD_CPL_INITIALIZE.
!-----------------------------------------------------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: MY_DOMAIN_ID                        !<-- The current domain's ID
!
!-----------------------------------------------------------------------
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!
!
      NCYCLE_CHILD =>cc%NCYCLE_CHILD
      NCYCLE_PARENT=>cc%NCYCLE_PARENT
!
      I_AM_A_FCST_TASK=>cc%I_AM_A_FCST_TASK
!
      COMM_TO_MY_PARENT    =>cc%COMM_TO_MY_PARENT
      I_CENTER_CURRENT     =>cc%I_CENTER_CURRENT
      I_SHIFT_CHILD        =>cc%I_SHIFT_CHILD
      J_SHIFT_CHILD        =>cc%J_SHIFT_CHILD
      I_SW_PARENT_CURRENT  =>cc%I_SW_PARENT_CURRENT
      I_SW_PARENT_NEW      =>cc%I_SW_PARENT_NEW
      J_CENTER_CURRENT     =>cc%J_CENTER_CURRENT
      J_SW_PARENT_CURRENT  =>cc%J_SW_PARENT_CURRENT
      J_SW_PARENT_NEW      =>cc%J_SW_PARENT_NEW
      ITS                  =>cc%ITS
      ITE                  =>cc%ITE
      JTS                  =>cc%JTS
      JTE                  =>cc%JTE
      JM                   =>cc%JM
      LM                   =>cc%LM
      IMS                  =>cc%IMS
      IME                  =>cc%IME
      JMS                  =>cc%JMS
      JME                  =>cc%JME
      IDS                  =>cc%IDS
      IDE                  =>cc%IDE
      JDS                  =>cc%JDS
      JDE                  =>cc%JDE
      IM_1                 =>cc%IM_1
      JM_1                 =>cc%JM_1
      INPES                =>cc%INPES
      JNPES                =>cc%JNPES
      INPES_PARENT         =>cc%INPES_PARENT
      JNPES_PARENT         =>cc%JNPES_PARENT
      KOUNT_2WAY_CHILDREN  =>cc%KOUNT_2WAY_CHILDREN
      LAST_STEP_MOVED      =>cc%LAST_STEP_MOVED
      MAX_SHIFT            =>cc%MAX_SHIFT
      MYPE                 =>cc%MYPE
      N_BLEND_H            =>cc%N_BLEND_H
      N_BLEND_V            =>cc%N_BLEND_V
      N_STENCIL_H          =>cc%N_STENCIL_H
      N_STENCIL_V          =>cc%N_STENCIL_V
      N_STENCIL_SFC_H      =>cc%N_STENCIL_SFC_H
      N_STENCIL_SFC_V      =>cc%N_STENCIL_SFC_V
      NLEV_H               =>cc%NLEV_H
      NLEV_V               =>cc%NLEV_V
      NHALO                =>cc%NHALO
      NPHS                 =>cc%NPHS
      NTASKS_UPDATE_PARENT =>cc%NTASKS_UPDATE_PARENT
      NTIMESTEP_CHECK      =>cc%NTIMESTEP_CHECK
      NTIMESTEP_FINAL      =>cc%NTIMESTEP_FINAL
      NTOT_SFC             =>cc%NTOT_SFC
      NTIMESTEPS_RESTART   =>cc%NTIMESTEPS_RESTART
      NTRACK               =>cc%NTRACK
      NUM_CHILDREN         =>cc%NUM_CHILDREN
      NUM_2WAY_CHILDREN    =>cc%NUM_2WAY_CHILDREN
      NUM_MOVING_CHILDREN  =>cc%NUM_MOVING_CHILDREN
      NUM_PES_FCST         =>cc%NUM_PES_FCST
      NUM_FCST_TASKS_PARENT=>cc%NUM_FCST_TASKS_PARENT
      NUM_TASKS_PARENT     =>cc%NUM_TASKS_PARENT
      NEXT_MOVE_TIMESTEP   =>cc%NEXT_MOVE_TIMESTEP
      NUM_LEVELS_MOVE_3D_H =>cc%NUM_LEVELS_MOVE_3D_H
      NUM_LEVELS_MOVE_3D_V =>cc%NUM_LEVELS_MOVE_3D_V
      NUM_SPACE_RATIOS_MVG =>cc%NUM_SPACE_RATIOS_MVG
      NVARS_BC_2D_H        =>cc%NVARS_BC_2D_H
      NVARS_BC_3D_H        =>cc%NVARS_BC_3D_H
      NVARS_BC_4D_H        =>cc%NVARS_BC_4D_H
      NVARS_BC_2D_V        =>cc%NVARS_BC_2D_V
      SPACE_RATIO_MY_PARENT=>cc%SPACE_RATIO_MY_PARENT
      TIME_RATIO_MY_PARENT =>cc%TIME_RATIO_MY_PARENT
!
      NTIMESTEP_WAIT_PARENT       =>cc%NTIMESTEP_WAIT_PARENT
      NTIMESTEP_WAIT_FORCED_PARENT=>cc%NTIMESTEP_WAIT_FORCED_PARENT
      PARENT_WANTS_TO_MOVE        =>cc%PARENT_WANTS_TO_MOVE
!
      LBND_4D=>cc%LBND_4D
      UBND_4D=>cc%UBND_4D
!
      LOCAL_ISTART=>cc%LOCAL_ISTART
      LOCAL_IEND  =>cc%LOCAL_IEND
      LOCAL_JSTART=>cc%LOCAL_JSTART
      LOCAL_JEND  =>cc%LOCAL_JEND
!
      MY_DOMAIN_LIMITS    =>cc%MY_DOMAIN_LIMITS
      MY_FORCED_SHIFT     =>cc%MY_FORCED_SHIFT
      MY_NEB              =>cc%MY_NEB
      PARENT_DOMAIN_LIMITS=>cc%PARENT_DOMAIN_LIMITS
      PARENT_SHIFT        =>cc%PARENT_SHIFT
      STORM_CENTER        =>cc%STORM_CENTER 
!
      PARENT_CHILD_SPACE_RATIO   =>cc%PARENT_CHILD_SPACE_RATIO
      TIME_RATIO_MY_CHILDREN     =>cc%TIME_RATIO_MY_CHILDREN
      IM_CHILD                   =>cc%IM_CHILD
      JM_CHILD                   =>cc%JM_CHILD
      I_PARENT_SW                =>cc%I_PARENT_SW
      J_PARENT_SW                =>cc%J_PARENT_SW
      ITE_PARENT                 =>cc%ITE_PARENT
      ITS_PARENT                 =>cc%ITS_PARENT
      JTE_PARENT                 =>cc%JTE_PARENT
      JTS_PARENT                 =>cc%JTS_PARENT
      LINK_MRANK_RATIO           =>cc%LINK_MRANK_RATIO
      LIST_OF_RATIOS             =>cc%LIST_OF_RATIOS
      M_NEST_RATIO               =>cc%M_NEST_RATIO
      N_STENCIL_H_CHILD          =>cc%N_STENCIL_H_CHILD
      N_STENCIL_V_CHILD          =>cc%N_STENCIL_V_CHILD
      N_STENCIL_SFC_H_CHILD      =>cc%N_STENCIL_SFC_H_CHILD
      N_STENCIL_SFC_V_CHILD      =>cc%N_STENCIL_SFC_V_CHILD
      N_BLEND_H_CHILD            =>cc%N_BLEND_H_CHILD
      N_BLEND_V_CHILD            =>cc%N_BLEND_V_CHILD
      CHILD_2WAY_WGT             =>cc%CHILD_2WAY_WGT
      NTASKS_UPDATE_CHILD        =>cc%NTASKS_UPDATE_CHILD
      NSTEP_CHILD_RECV           =>cc%NSTEP_CHILD_RECV
      INC_FIX                    =>cc%INC_FIX
      COMM_TO_MY_CHILDREN        =>cc%COMM_TO_MY_CHILDREN
      ID_PARENTS                 =>cc%ID_PARENTS
      ID_PARENT_UPDATE_TASKS     =>cc%ID_PARENT_UPDATE_TASKS
      MY_CHILDREN_ID             =>cc%MY_CHILDREN_ID
      RANK_2WAY_CHILD            =>cc%RANK_2WAY_CHILD
      RANK_MOVING_CHILD          =>cc%RANK_MOVING_CHILD
      FTASKS_DOMAIN              =>cc%FTASKS_DOMAIN
      NTASKS_DOMAIN              =>cc%NTASKS_DOMAIN
      NPTS_UPDATE_ON_PARENT_TASKS=>cc%NPTS_UPDATE_ON_PARENT_TASKS
      HANDLE_BC_UPDATE           =>cc%HANDLE_BC_UPDATE
      HANDLE_MOVE_FLAG           =>cc%HANDLE_MOVE_FLAG
      HANDLE_PARENT_SHIFT        =>cc%HANDLE_PARENT_SHIFT
      HANDLE_SEND_2WAY_DATA      =>cc%HANDLE_SEND_2WAY_DATA
      HANDLE_SEND_2WAY_SFC       =>cc%HANDLE_SEND_2WAY_SFC
      HANDLE_SEND_2WAY_SIGNAL    =>cc%HANDLE_SEND_2WAY_SIGNAL
      HANDLE_SEND_ALLCLEAR       =>cc%HANDLE_SEND_ALLCLEAR
      HANDLE_TIMESTEP            =>cc%HANDLE_TIMESTEP
      NTIMESTEP_CHILD_MOVES      =>cc%NTIMESTEP_CHILD_MOVES
      SHIFT_INFO_MINE            =>cc%SHIFT_INFO_MINE
!
      SHIFT_INFO_CHILDREN=>cc%SHIFT_INFO_CHILDREN
!
      NUM_TASKS_SEND_H_S=>cc%NUM_TASKS_SEND_H_S
      NUM_TASKS_SEND_H_N=>cc%NUM_TASKS_SEND_H_N
      NUM_TASKS_SEND_H_W=>cc%NUM_TASKS_SEND_H_W
      NUM_TASKS_SEND_H_E=>cc%NUM_TASKS_SEND_H_E
      NUM_TASKS_SEND_V_S=>cc%NUM_TASKS_SEND_V_S
      NUM_TASKS_SEND_V_N=>cc%NUM_TASKS_SEND_V_N
      NUM_TASKS_SEND_V_W=>cc%NUM_TASKS_SEND_V_W
      NUM_TASKS_SEND_V_E=>cc%NUM_TASKS_SEND_V_E
!
      CENTERS_DISTANCE=>cc%CENTERS_DISTANCE
      DLM             =>cc%DLM
      DPH             =>cc%DPH
      DYH             =>cc%DYH
      PDTOP           =>cc%PDTOP
      PT              =>cc%PT
      SB_1            =>cc%SB_1
      WB_1            =>cc%WB_1
      TPH0_1          =>cc%TPH0_1
      TLM0_1          =>cc%TLM0_1
      RECIP_DPH_1     =>cc%RECIP_DPH_1
      RECIP_DLM_1     =>cc%RECIP_DLM_1
      RECIP_PARENT_SPACE_RATIO=>cc%RECIP_PARENT_SPACE_RATIO
!
      DT_DOMAIN=>cc%DT_DOMAIN
      DXH      =>cc%DXH
      DSG2     =>cc%DSG2
      PDSG1    =>cc%PDSG1
      PSGML1   =>cc%PSGML1
      SG1      =>cc%SG1
      SG2      =>cc%SG2
      SGML2    =>cc%SGML2
!
      CHILD_PARENT_SPACE_RATIO=>cc%CHILD_PARENT_SPACE_RATIO
!
      BOUND_1D_SOUTH_H=>cc%BOUND_1D_SOUTH_H
      BOUND_1D_SOUTH_V=>cc%BOUND_1D_SOUTH_V
      BOUND_1D_NORTH_H=>cc%BOUND_1D_NORTH_H
      BOUND_1D_NORTH_V=>cc%BOUND_1D_NORTH_V
      BOUND_1D_WEST_H =>cc%BOUND_1D_WEST_H
      BOUND_1D_WEST_V =>cc%BOUND_1D_WEST_V
      BOUND_1D_EAST_H =>cc%BOUND_1D_EAST_H
      BOUND_1D_EAST_V =>cc%BOUND_1D_EAST_V
!
      FIS                =>cc%FIS
      FIS_CHILD_ON_PARENT=>cc%FIS_CHILD_ON_PARENT
      GLAT               =>cc%GLAT
      GLON               =>cc%GLON
      PD                 =>cc%PD
      SM                 =>cc%PD
      U10                =>cc%U10
      V10                =>cc%V10
!
      PDB_S=>cc%PDB_S
      PDB_N=>cc%PDB_N
      PDB_W=>cc%PDB_W
      PDB_E=>cc%PDB_E
!
      CW  =>cc%CW
      PINT=>cc%PINT
      Q   =>cc%Q
      T   =>cc%T
      U   =>cc%U
      V   =>cc%V
      Z   =>cc%Z
!
      TRACERS=>cc%TRACERS
!
      STATIC_OR_MOVING=>cc%STATIC_OR_MOVING
!
      ALLCLEAR_SIGNAL_PRESENT      =>cc%ALLCLEAR_SIGNAL_PRESENT
      CALLED_CHILD_2WAY_BOOKKEEPING=>cc%CALLED_CHILD_2WAY_BOOKKEEPING
      FIRST_CALL_RECV_2WAY         =>cc%FIRST_CALL_RECV_2WAY
      FIRST_CALL_RECV_BC           =>cc%FIRST_CALL_RECV_BC
      FORCED_PARENT_SHIFT          =>cc%FORCED_PARENT_SHIFT
      I_AM_ACTIVE                  =>cc%I_AM_ACTIVE
      I_AM_LEAD_FCST_TASK          =>cc%I_AM_LEAD_FCST_TASK
      I_WANT_TO_MOVE               =>cc%I_WANT_TO_MOVE
      MOVE_FLAG_SENT               =>cc%MOVE_FLAG_SENT
      MY_DOMAIN_MOVES              =>cc%MY_DOMAIN_MOVES
      MY_PARENT_MOVES              =>cc%MY_PARENT_MOVES
!
      CALLED_PARENT_2WAY_BOOKKEEPING=>cc%CALLED_PARENT_2WAY_BOOKKEEPING
      CHILD_ACTIVE          =>cc%CHILD_ACTIVE
      CHILD_FORCES_MY_SHIFT =>cc%CHILD_FORCES_MY_SHIFT
      MOVE_FLAG             =>cc%MOVE_FLAG
      SEND_CHILD_DATA       =>cc%SEND_CHILD_DATA
      SIGNAL_2WAY_SEND_READY=>cc%SIGNAL_2WAY_SEND_READY
      SKIP_2WAY_UPDATE      =>cc%SKIP_2WAY_UPDATE
!
      I_2WAY_UPDATE=>cc%I_2WAY_UPDATE
      J_2WAY_UPDATE=>cc%J_2WAY_UPDATE
!
      I_2WAY_H=>cc%I_2WAY_H
      J_2WAY_H=>cc%J_2WAY_H
      I_2WAY_V=>cc%I_2WAY_V
      J_2WAY_V=>cc%J_2WAY_V
!
      WORDS_BOUND_H_SOUTH  =>cc%WORDS_BOUND_H_SOUTH
      WORDS_BOUND_H_NORTH  =>cc%WORDS_BOUND_H_NORTH
      WORDS_BOUND_H_WEST   =>cc%WORDS_BOUND_H_WEST
      WORDS_BOUND_H_EAST   =>cc%WORDS_BOUND_H_EAST
!
      WORDS_BOUND_V_SOUTH=>cc%WORDS_BOUND_V_SOUTH
      WORDS_BOUND_V_NORTH=>cc%WORDS_BOUND_V_NORTH
      WORDS_BOUND_V_WEST =>cc%WORDS_BOUND_V_WEST
      WORDS_BOUND_V_EAST =>cc%WORDS_BOUND_V_EAST
!
      CHILD_SFC_ON_PARENT=>cc%CHILD_SFC_ON_PARENT
      UPDATE_PARENT_2WAY=>cc%UPDATE_PARENT_2WAY
!
      NEST_FIS_ON_PARENT  =>cc%NEST_FIS_ON_PARENT
      NEST_FIS_V_ON_PARENT=>cc%NEST_FIS_V_ON_PARENT
!
      PD_B_SOUTH=>cc%PD_B_SOUTH
      PD_B_NORTH=>cc%PD_B_NORTH
      PD_B_WEST =>cc%PD_B_WEST
      PD_B_EAST =>cc%PD_B_EAST
!
      PD_B_SOUTH_V=>cc%PD_B_SOUTH_V
      PD_B_NORTH_V=>cc%PD_B_NORTH_V
      PD_B_WEST_V =>cc%PD_B_WEST_V
      PD_B_EAST_V =>cc%PD_B_EAST_V
!
      MY_BC_VARS_H_S=>cc%MY_BC_VARS_H_S
      MY_BC_VARS_H_N=>cc%MY_BC_VARS_H_N
      MY_BC_VARS_H_W=>cc%MY_BC_VARS_H_W
      MY_BC_VARS_H_E=>cc%MY_BC_VARS_H_E
      MY_BC_VARS_V_S=>cc%MY_BC_VARS_V_S
      MY_BC_VARS_V_N=>cc%MY_BC_VARS_V_N
      MY_BC_VARS_V_W=>cc%MY_BC_VARS_V_W
      MY_BC_VARS_V_E=>cc%MY_BC_VARS_V_E
!
      BND_VAR_H_SOUTH=>cc%BND_VAR_H_SOUTH
      BND_VAR_H_NORTH=>cc%BND_VAR_H_NORTH
      BND_VAR_H_WEST =>cc%BND_VAR_H_WEST
      BND_VAR_H_EAST =>cc%BND_VAR_H_EAST
      BND_VAR_V_SOUTH=>cc%BND_VAR_V_SOUTH
      BND_VAR_V_NORTH=>cc%BND_VAR_V_NORTH
      BND_VAR_V_WEST =>cc%BND_VAR_V_WEST
      BND_VAR_V_EAST =>cc%BND_VAR_V_EAST
!
      FIS_CHILD_SOUTH=>cc%FIS_CHILD_SOUTH
      FIS_CHILD_NORTH=>cc%FIS_CHILD_NORTH
      FIS_CHILD_WEST =>cc%FIS_CHILD_WEST
      FIS_CHILD_EAST =>cc%FIS_CHILD_EAST
!
      CHILD_BOUND_H_SOUTH=>cc%CHILD_BOUND_H_SOUTH
      CHILD_BOUND_H_NORTH=>cc%CHILD_BOUND_H_NORTH
      CHILD_BOUND_H_WEST =>cc%CHILD_BOUND_H_WEST
      CHILD_BOUND_H_EAST =>cc%CHILD_BOUND_H_EAST
      CHILD_BOUND_V_SOUTH=>cc%CHILD_BOUND_V_SOUTH
      CHILD_BOUND_V_NORTH=>cc%CHILD_BOUND_V_NORTH
      CHILD_BOUND_V_WEST =>cc%CHILD_BOUND_V_WEST
      CHILD_BOUND_V_EAST =>cc%CHILD_BOUND_V_EAST
!
      NEST_FIS_ON_PARENT_BNDS=>cc%NEST_FIS_ON_PARENT_BNDS
!
      INDX_MAX_H=>cc%INDX_MAX_H
      INDX_MAX_V=>cc%INDX_MAX_V
      INDX_MIN_H=>cc%INDX_MIN_H
      INDX_MIN_V=>cc%INDX_MIN_V
!
      NUM_PARENT_TASKS_SENDING_H=>cc%NUM_PARENT_TASKS_SENDING_H
      NUM_PARENT_TASKS_SENDING_V=>cc%NUM_PARENT_TASKS_SENDING_V
!
      CHILDTASK_BNDRY_H_RANKS=>cc%CHILDTASK_BNDRY_H_RANKS
      CHILDTASK_BNDRY_V_RANKS=>cc%CHILDTASK_BNDRY_V_RANKS
!
      CHILDTASK_H_SAVE=>cc%CHILDTASK_H_SAVE
      CHILDTASK_V_SAVE=>cc%CHILDTASK_V_SAVE
!
      PARENT_4_INDICES_H=>cc%PARENT_4_INDICES_H
      PARENT_4_INDICES_V=>cc%PARENT_4_INDICES_V
!
      PARENT_4_WEIGHTS_H=>cc%PARENT_4_WEIGHTS_H
      PARENT_4_WEIGHTS_V=>cc%PARENT_4_WEIGHTS_V
!
      PARENT_TASK=>cc%PARENT_TASK
!
      HANDLE_MOVE_DATA=>cc%HANDLE_MOVE_DATA
!
      HANDLE_H_SOUTH=>cc%HANDLE_H_SOUTH
      HANDLE_H_NORTH=>cc%HANDLE_H_NORTH
      HANDLE_H_WEST =>cc%HANDLE_H_WEST
      HANDLE_H_EAST =>cc%HANDLE_H_EAST
      HANDLE_V_SOUTH=>cc%HANDLE_V_SOUTH
      HANDLE_V_NORTH=>cc%HANDLE_V_NORTH
      HANDLE_V_WEST =>cc%HANDLE_V_WEST
      HANDLE_V_EAST =>cc%HANDLE_V_EAST
!
      CF_PARENT=>cc%CF_PARENT
      CF_MINE  =>cc%CF_MINE
      CF       =>cc%CF
!
      BUNDLE_2WAY  =>cc%BUNDLE_2WAY
      BUNDLE_NESTBC=>cc%BUNDLE_NESTBC
      MOVE_BUNDLE_H=>cc%MOVE_BUNDLE_H
      MOVE_BUNDLE_V=>cc%MOVE_BUNDLE_V
!
      cpl1_prelim_tim =>cc%cpl1_prelim_tim
      cpl1_south_h_tim=>cc%cpl1_south_h_tim
      cpl1_south_v_tim=>cc%cpl1_south_v_tim
      cpl1_north_h_tim=>cc%cpl1_north_h_tim
      cpl1_north_v_tim=>cc%cpl1_north_v_tim
      cpl1_west_h_tim =>cc%cpl1_west_h_tim
      cpl1_west_v_tim =>cc%cpl1_west_v_tim
      cpl1_east_h_tim =>cc%cpl1_east_h_tim
      cpl1_east_v_tim =>cc%cpl1_east_v_tim
      cpl1_recv_tim   =>cc%cpl1_recv_tim
      cpl1_south_h_recv_tim=>cc%cpl1_south_h_recv_tim
      cpl1_south_h_undo_tim=>cc%cpl1_south_h_undo_tim
      cpl1_south_h_exp_tim =>cc%cpl1_south_h_exp_tim
      cpl1_south_v_recv_tim=>cc%cpl1_south_v_recv_tim
      cpl1_south_v_undo_tim=>cc%cpl1_south_v_undo_tim
      cpl1_south_v_exp_tim =>cc%cpl1_south_v_exp_tim
      cpl2_comp_tim        =>cc%cpl2_comp_tim
      cpl2_send_tim        =>cc%cpl2_send_tim
      cpl2_wait_tim        =>cc%cpl2_wait_tim
      moving_nest_bookkeep_tim=>cc%moving_nest_bookkeep_tim
      moving_nest_update_tim  =>cc%moving_nest_update_tim
      parent_bookkeep_moving_tim=>cc%parent_bookkeep_moving_tim
      parent_update_moving_tim  =>cc%parent_update_moving_tim
      t0_recv_move_tim          =>cc%t0_recv_move_tim
      read_moving_child_topo_tim =>cc%read_moving_child_topo_tim
      barrier_move_tim          =>cc%barrier_move_tim
      pscd_tim=>cc%pscd_tim
      pscd1_tim=>cc%pscd1_tim
      pscd2_tim=>cc%pscd2_tim
      pscd3_tim=>cc%pscd3_tim
      pscd4_tim=>cc%pscd4_tim
      ja1_tim=>cc%ja1_tim
      ja2_tim=>cc%ja2_tim
      ja3_tim=>cc%ja3_tim
      ja4_tim=>cc%ja4_tim
      jat_tim=>cc%jat_tim
!
!----------------------------------------
!***  The following are for moving nests
!----------------------------------------
!
      I_EAST_M=>cc%I_EAST_M
      I_WEST_M=>cc%I_WEST_M
      J_NORTH_M=>cc%J_NORTH_M
      J_SOUTH_M=>cc%J_SOUTH_M
!
      I_MAX=>cc%I_MAX
      I_MIN=>cc%I_MIN
      J_MAX=>cc%J_MAX
      J_MIN=>cc%J_MIN
!
      NPTS_NS=>cc%NPTS_NS
      NPTS_WE=>cc%NPTS_WE
!
      I_PG=>cc%I_PG
      J_PG=>cc%J_PG
!
      COEF=>cc%COEF
      RNPTS_HZ=>cc%RNPTS_HZ
      ELAPSED_TIME_MIN=>cc%ELAPSED_TIME_MIN
!
      FIRST_PASS_M   =>cc%FIRST_PASS_M
      FIRST_STEP_2WAY=>cc%FIRST_STEP_2WAY
      IN_WINDOW      =>cc%IN_WINDOW
      STOP_MY_MOTION =>cc%STOP_MY_MOTION
!
      I_HOLD_CENTER_POINT=>cc%I_HOLD_CENTER_POINT
      I_HOLD_PG_POINT=>cc%I_HOLD_PG_POINT
!
      MOVING_CHILD_UPDATE=>cc%MOVING_CHILD_UPDATE
      TASK_UPDATE_SPECS=>cc%TASK_UPDATE_SPECS
!
      MOVE_TYPE=>CC%MOVE_TYPE
!
      MOVE_INTERVAL_MINUTES=>CC%MOVE_INTERVAL_MINUTES
      N_MOVES=>CC%N_MOVES
      MOVE_MINUTE=>CC%MOVE_MINUTE
      MOVE_I_SW=>CC%MOVE_I_SW
      MOVE_J_SW=>CC%MOVE_J_SW
!
!----------------------------------------
!***  The following is for 2-way nesting
!----------------------------------------
!
      CHILD_TASKS_2WAY_UPDATE=>cc%CHILD_TASKS_2WAY_UPDATE
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE POINT_TO_COMPOSITE
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_CHILD_INTERP_SETUP(MY_DOMAIN_ID                 &
                                          ,NUM_CHILDREN                 &
                                          ,MY_CHILDREN_ID               &
                                          ,IM_CHILD                     &
                                          ,JM_CHILD                     &
                                          ,FTASKS_DOMAIN                &
                                          ,N_BLEND_H_CHILD              &
                                          ,N_BLEND_V_CHILD              &
                                          ,CF                           &
                                          ,ITS,ITE,JTS,JTE              &
                                          ,IDS,IDE,JDS,JDE )
!
!-----------------------------------------------------------------------
!
!***  ALLOCATE THREE PRIMARY INTERPOLATION QUANTITIES NEEDED BY 
!***  A PARENT DOMAIN TO GENERATE BOUNDARY DATA FOR ITS CHILDREN:
!
!    (1) Children's boundary index limits on each parent task;
!    (2) Parent I's and J's surrounding each child boundary point;
!    (3) Bilinear weights of each parent point surrounding each
!        child boundary point.   
!
!-----------------------------------------------------------------------
!
!***  ONLY PARENT TASKS EXECUTE THIS ROUTINE.
!
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: ITS,ITE,JTS,JTE                  &
                                      ,IDS,IDE,JDS,JDE                  &
                                      ,MY_DOMAIN_ID                     &
                                      ,NUM_CHILDREN
!
      INTEGER(kind=KINT),DIMENSION(1:NUM_CHILDREN),INTENT(IN) :: IM_CHILD         &
                                                                ,JM_CHILD         &
                                                                ,N_BLEND_H_CHILD  &
                                                                ,N_BLEND_V_CHILD 
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) :: FTASKS_DOMAIN  &
                                                           ,MY_CHILDREN_ID         
!
      TYPE(ESMF_Config),DIMENSION(1:NUM_CHILDREN),INTENT(INOUT) :: CF
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: N,N_CHILD_TASKS,NUM_CHILD_TASKS             &
                           ,THIS_CHILD_ID
!
      INTEGER(kind=KINT) :: EAST_LIMIT1 ,EAST_LIMIT2                    &
                           ,WEST_LIMIT1 ,WEST_LIMIT2                    &
                           ,NORTH_LIMIT1,NORTH_LIMIT2                   &
                           ,SOUTH_LIMIT1,SOUTH_LIMIT2
!
      INTEGER(kind=KINT) :: ISTAT,RC,RC_SET 
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RC    =ESMF_SUCCESS
      RC_SET=ESMF_SUCCESS
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Allocate the pointers that hold the four H and V parent points
!***  that surround each child point in the child's boundary region.
!-----------------------------------------------------------------------
!
      ALLOCATE(CC%PARENT_4_INDICES_H(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PARENT_4_INDICES_H stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      PARENT_4_INDICES_H=>cc%PARENT_4_INDICES_H
!
      ALLOCATE(CC%PARENT_4_INDICES_V(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PARENT_4_INDICES_V stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      PARENT_4_INDICES_V=>cc%PARENT_4_INDICES_V
!
!-----------------------------------------------------------------------
!***  Allocate the pointers that hold the weights of the four H and V 
!***  parent points that surround each child point in the child's 
!***  boundary region.
!-----------------------------------------------------------------------
!
      ALLOCATE(CC%PARENT_4_WEIGHTS_H(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PARENT_4_WEIGHTS_H stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      PARENT_4_WEIGHTS_H=>CC%PARENT_4_WEIGHTS_H
!
      ALLOCATE(CC%PARENT_4_WEIGHTS_V(1:NUM_CHILDREN))
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%PARENT_4_WEIGHTS_V stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      PARENT_4_WEIGHTS_V=>CC%PARENT_4_WEIGHTS_V
!
!-----------------------------------------------------------------------
!***  Allocate the arrays that hold the number of child tasks 
!***  on each side of the child boundaries that will be sent
!***  data from the parent tasks.
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%NUM_TASKS_SEND_H_S(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%NUM_TASKS_SEND_H_S stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      NUM_TASKS_SEND_H_S=>cc%NUM_TASKS_SEND_H_S
!
      ALLOCATE(cc%NUM_TASKS_SEND_H_N(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_H_N=>cc%NUM_TASKS_SEND_H_N
!
      ALLOCATE(cc%NUM_TASKS_SEND_H_W(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_H_W=>cc%NUM_TASKS_SEND_H_W
!
      ALLOCATE(cc%NUM_TASKS_SEND_H_E(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_H_E=>cc%NUM_TASKS_SEND_H_E
!
      ALLOCATE(cc%NUM_TASKS_SEND_V_S(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_V_S=>cc%NUM_TASKS_SEND_V_S
!
      ALLOCATE(cc%NUM_TASKS_SEND_V_N(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_V_N=>cc%NUM_TASKS_SEND_V_N
!
      ALLOCATE(cc%NUM_TASKS_SEND_V_W(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_V_W=>cc%NUM_TASKS_SEND_V_W
!
      ALLOCATE(cc%NUM_TASKS_SEND_V_E(1:NUM_CHILDREN),stat=ISTAT)
      NUM_TASKS_SEND_V_E=>cc%NUM_TASKS_SEND_V_E
!
!-----------------------------------------------------------------------
!***  Allocate the pointers that will hold the ranks of all child tasks 
!***  on each side of the child boundaries that will be sent data
!***  from the parent tasks.
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%CHILDTASK_BNDRY_H_RANKS(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%CHILDTASK_BNDRY_H_RANKS stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      CHILDTASK_BNDRY_H_RANKS=>cc%CHILDTASK_BNDRY_H_RANKS
!
      ALLOCATE(cc%CHILDTASK_BNDRY_V_RANKS(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%CHILDTASK_BNDRY_V_RANKS stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      CHILDTASK_BNDRY_V_RANKS=>cc%CHILDTASK_BNDRY_V_RANKS
!
!-----------------------------------------------------------------------
!***  Allocate the pointers for starting/ending I's and J's on each
!***  parent task for each side of the boundary.
!-----------------------------------------------------------------------
!
      ALLOCATE(cc%CHILDTASK_H_SAVE(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%CHILDTASK_H_SAVE stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      CHILDTASK_H_SAVE=>cc%CHILDTASK_H_SAVE
!
      ALLOCATE(cc%CHILDTASK_V_SAVE(1:NUM_CHILDREN),stat=ISTAT)
      IF(ISTAT/=0)THEN
        WRITE(0,*)' Failed to allocate cpl_composite%CHILDTASK_V_SAVE stat=',ISTAT
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
      CHILDTASK_V_SAVE=>cc%CHILDTASK_V_SAVE
!
!-----------------------------------------------------------------------
!***  Extract relevant information from the children's configure files.
!-----------------------------------------------------------------------
!
      child_loop_0: DO N=1,NUM_CHILDREN
!
        THIS_CHILD_ID=MY_CHILDREN_ID(N)
!
!-----------------------------------------------------------------------
!***  Invert the Parent-to-Child space ratio for computation.
!-----------------------------------------------------------------------
!
        CHILD_PARENT_SPACE_RATIO(N)=1./REAL(PARENT_CHILD_SPACE_RATIO(N))
!
!-----------------------------------------------------------------------
!***  Allocate the individual pointers holding the four H points of
!***  the parent that surround this child's boundary region H points
!***  and the bilinear interpolation weights of the four parent points
!***  surrounding those same child points.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!   ***************************  NOTE  *****************************
!-----------------------------------------------------------------------
!     Although the H points in the nests' boundary region cover only
!     N_BLEND rows, we actually need to have the nests' PD values
!     one row further.  That is because we also need PD values at the 
!     V points in the nests' boundary region to perform the proper
!     hydrostatic updating of the winds by the parents there.  To
!     do the 4-point average needed to obtain PD on V points, we
!     necessarily must have them on mass points one row beyond where 
!     they are needed for the mass points alone.
!-----------------------------------------------------------------------
!   ***************************  NOTE  *****************************
!-----------------------------------------------------------------------
!
        SOUTH_LIMIT1=1
        SOUTH_LIMIT2=N_BLEND_H_CHILD(N)+1                                  !<-- Extend the region by 1 row for 4-point averaging of PD
!
        NORTH_LIMIT1=JM_CHILD(N)-N_BLEND_H_CHILD(N)                        !<-- Extend the region by 1 row for 4-point averaging of PD
        NORTH_LIMIT2=JM_CHILD(N)
!
        WEST_LIMIT1=1
        WEST_LIMIT2=N_BLEND_H_CHILD(N)+1                                   !<-- Extend the region by 1 row for 4-point averaging of PD
!
        EAST_LIMIT1=IM_CHILD(N)-N_BLEND_H_CHILD(N)                         !<-- Extend the region by 1 row for 4-point averaging of PD
        EAST_LIMIT2=IM_CHILD(N)
!
!--------------------------
!***  Parent point indices
!--------------------------
!
        ALLOCATE(PARENT_4_INDICES_H(N)%I_INDX_SBND(1:IM_CHILD(N)              &  !<-- Parent I's west/east of child south bndry H points
                                                  ,SOUTH_LIMIT1:SOUTH_LIMIT2  &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%I_INDX_NBND(1:IM_CHILD(N)              &  !<-- Parent I's west/east of child north bndry H points
                                                  ,NORTH_LIMIT1:NORTH_LIMIT2  &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%I_INDX_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Parent I's west/east of child west bndry H points
                                                  ,1:JM_CHILD(N)              &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%I_INDX_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Parent I's west/east of child east bndry H points
                                                  ,1:JM_CHILD(N)              &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%J_INDX_SBND(1:IM_CHILD(N)              &  !<-- Parent J's south/north of child south bndry H points
                                                  ,SOUTH_LIMIT1:SOUTH_LIMIT2  &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%J_INDX_NBND(1:IM_CHILD(N)              &  !<-- Parent J's south/north of child north bndry H points
                                                  ,NORTH_LIMIT1:NORTH_LIMIT2  &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%J_INDX_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Parent J's south/north of child west bndry H points
                                                  ,1:JM_CHILD(N)              &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_H(N)%J_INDX_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Parent J's south/north of child east bndry H points
                                                  ,1:JM_CHILD(N)              &
                                                  ,1:2))
!
!--------------------------
!***  Parent point weights
!--------------------------
!
        ALLOCATE(PARENT_4_WEIGHTS_H(N)%WEIGHTS_SBND(1:IM_CHILD(N)              &  !<-- Bilinear interpolation weights of parent points
                                                   ,SOUTH_LIMIT1:SOUTH_LIMIT2  &  !     surrounding child south bndry region H points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_H(N)%WEIGHTS_NBND(1:IM_CHILD(N)              &  !<-- Bilinear interpolation weights of parent points
                                                   ,NORTH_LIMIT1:NORTH_LIMIT2  &  !     surrounding child north bndry region H points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_H(N)%WEIGHTS_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Bilinear interpolation weights of parent points
                                                   ,1:JM_CHILD(N)              &  !     surrounding child west bndry region H points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_H(N)%WEIGHTS_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Bilinear interpolation weights of parent points
                                                   ,1:JM_CHILD(N)              &  !     surrounding child east bndry region H points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
!-----------------------------------------------------------------------
!***  Allocate the individual pointers holding the four V points of
!***  the parent that surround this child's boundary region V points.
!-----------------------------------------------------------------------
!
        SOUTH_LIMIT1=1
        SOUTH_LIMIT2=N_BLEND_V_CHILD(N)
!
        NORTH_LIMIT1=JM_CHILD(N)-1-N_BLEND_V_CHILD(N)+1
        NORTH_LIMIT2=JM_CHILD(N)-1
!
        WEST_LIMIT1=1
        WEST_LIMIT2=N_BLEND_V_CHILD(N)
!
        EAST_LIMIT1=IM_CHILD(N)-1-N_BLEND_V_CHILD(N)+1
        EAST_LIMIT2=IM_CHILD(N)-1
!
!--------------------------
!***  Parent point indices
!--------------------------
!
        ALLOCATE(PARENT_4_INDICES_V(N)%I_INDX_SBND(1:IM_CHILD(N)-1            &  !<-- Parent I's west/east of child south bndry V points.
                                                  ,SOUTH_LIMIT1:SOUTH_LIMIT2  &
                                                  ,1:2))                     
!
        ALLOCATE(PARENT_4_INDICES_V(N)%I_INDX_NBND(1:IM_CHILD(N)-1            &  !<-- Parent I's west/east of child north bndry V points.
                                                  ,NORTH_LIMIT1:NORTH_LIMIT2  &
                                                  ,1:2))                      
!
        ALLOCATE(PARENT_4_INDICES_V(N)%I_INDX_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Parent I's west/east of child west bndry V points.
                                                  ,1:JM_CHILD(N)-1            &
                                                  ,1:2))                       
!
        ALLOCATE(PARENT_4_INDICES_V(N)%I_INDX_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Parent I's west/east of child east bndry V points.
                                                  ,1:JM_CHILD(N)-1            &
                                                  ,1:2))                        
!
        ALLOCATE(PARENT_4_INDICES_V(N)%J_INDX_SBND(1:IM_CHILD(N)-1            &  !<-- Parent J's south/north of child south bndry V points.
                                                  ,SOUTH_LIMIT1:SOUTH_LIMIT2  &
                                                  ,1:2))                    
!
        ALLOCATE(PARENT_4_INDICES_V(N)%J_INDX_NBND(1:IM_CHILD(N)-1            &  !<-- Parent J's south/north of child north bndry V points.
                                                  ,NORTH_LIMIT1:NORTH_LIMIT2  &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_V(N)%J_INDX_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Parent J's south/north of child west bndry V points.
                                                  ,1:JM_CHILD(N)-1            &
                                                  ,1:2))
!
        ALLOCATE(PARENT_4_INDICES_V(N)%J_INDX_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Parent J's south/north of child east bndry V points.
                                                  ,1:JM_CHILD(N)-1            &
                                                  ,1:2))
!
!--------------------------
!***  Parent point weights
!--------------------------
!
        ALLOCATE(PARENT_4_WEIGHTS_V(N)%WEIGHTS_SBND(1:IM_CHILD(N)-1            &  !<-- Bilinear interpolation weights of parent points
                                                   ,SOUTH_LIMIT1:SOUTH_LIMIT2  &  !     surrounding child south bndry region V points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_V(N)%WEIGHTS_NBND(1:IM_CHILD(N)-1            &  !<-- Bilinear interpolation weights of parent points
                                                   ,NORTH_LIMIT1:NORTH_LIMIT2  &  !     surrounding child north bndry region V points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_V(N)%WEIGHTS_WBND(WEST_LIMIT1:WEST_LIMIT2    &  !<-- Bilinear interpolation weights of parent points
                                                   ,1:JM_CHILD(N)-1            &  !     surrounding child west bndry region V points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
        ALLOCATE(PARENT_4_WEIGHTS_V(N)%WEIGHTS_EBND(EAST_LIMIT1:EAST_LIMIT2    &  !<-- Bilinear interpolation weights of parent points
                                                   ,1:JM_CHILD(N)-1            &  !     surrounding child east bndry region V points.
                                                   ,1:4))                         !     1:4 indicates SW, SE, NW, NE of child point.
!
!-----------------------------------------------------------------------
!***  What is the number of forecast tasks on the child domain?
!-----------------------------------------------------------------------
!
        NUM_CHILD_TASKS=FTASKS_DOMAIN(THIS_CHILD_ID)
!
!-----------------------------------------------------------------------
!***  Allocate the pointers for starting/ending I's and J's on each
!***  parent task for each side of the boundary.
!-----------------------------------------------------------------------
!
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_LO_SOUTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_HI_SOUTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_LO_NORTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_HI_NORTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_LO_WEST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_HI_WEST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_LO_EAST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_HI_EAST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER (1:NUM_CHILD_TASKS))
!
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_LO_SOUTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_HI_SOUTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_HI_SOUTH_TRANSFER(1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_LO_NORTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_HI_NORTH   (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%I_HI_NORTH_TRANSFER(1:NUM_CHILD_TASKS)) 
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_LO_WEST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_HI_WEST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_HI_WEST_TRANSFER(1:NUM_CHILD_TASKS)) 
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_LO_EAST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_HI_EAST    (1:NUM_CHILD_TASKS))
        ALLOCATE(CHILDTASK_V_SAVE(N)%J_HI_EAST_TRANSFER(1:NUM_CHILD_TASKS))
!
!-----------------------------------------------------------------------
!***  Allocate the pointers for the child task ID's that contain
!***  segments of the child boundary within a parent task for
!***  each side of the boundary.
!-----------------------------------------------------------------------
!
        ALLOCATE(CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_H_RANKS(N)%NORTH(1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_H_RANKS(N)%WEST (1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_H_RANKS(N)%EAST (1:NUM_CHILD_TASKS,2))
!
        ALLOCATE(CHILDTASK_BNDRY_V_RANKS(N)%SOUTH(1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_V_RANKS(N)%NORTH(1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_V_RANKS(N)%WEST (1:NUM_CHILD_TASKS,2))
        ALLOCATE(CHILDTASK_BNDRY_V_RANKS(N)%EAST (1:NUM_CHILD_TASKS,2))
!
!-----------------------------------------------------------------------
!
      ENDDO child_loop_0
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_CHILD_INTERP_SETUP
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PREPARE_NEST_INTERP_FACTORS(N_CHILD,MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Call the routine that computes the interpolation factors
!***  each parent needs in order to interpolate its data to 
!***  its nests' boundaries.
!
!***  Only parent tasks execute this routine.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &  !<-- The parent's N-CHILD'th child
                                      ,MY_DOMAIN_ID                        !<-- The parent's domain ID
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: ITE_CHILD_X,JTE_CHILD_X                     &
                           ,N,N_CHILD_TASKS,NCX,NT,NUM_CHILD_TASKS
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  The parent sets up quantities to be used for general
!***  bilinear interpolation from the parent to its children's
!***  boundary regions.  These quantities are:
!
!  (1a) The westernmost/eastermost I's of children's south/north
!       boundary region points on this parent task's subdomain.
!  (1b) The southernmost/northernmost J's of children's west/east
!       boundary region points on this parent task's subdomain.
!   (2) The I,J of the four parent points surrounding each
!       child's boundary region point.
!   (3) The bilinear interpolation weights for each of the four
!       parent points surrounding each child's boundary region 
!       point.
!-----------------------------------------------------------------------
!
      N=N_CHILD
!
        NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N))                   !<-- # of fcst tasks on this parent's Nth child
!
!------------------------------------------------------------
!***  Compute interpolation indices and weights for H points
!------------------------------------------------------------
!
        CALL PARENT_TO_CHILD_INTERP_FACTORS('H_POINTS'                  &
                                           ,N_CHILD                     &
                                           ,I_PARENT_SW(N)              &
                                           ,J_PARENT_SW(N)              &
                                           ,N_BLEND_H_CHILD(N)          &
!
                                           ,IM_CHILD(N)                 &
                                           ,JM_CHILD(N)                 &
!
                                           ,NUM_CHILD_TASKS             &
                          ,CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA  &
                          ,CHILD_RANKS(MY_DOMAIN_ID)%CHILDREN(N)%DATA   &
!                                                                                 ^
                                           ,CHILD_PARENT_SPACE_RATIO(N) & !       |
!                                                                         !       |
                                           ,ITS,ITE,JTS,JTE             & !       |  
                                           ,IDS,IDE,JDS,JDE             & !     Input
!                                                                          -----------------
                                           ,NUM_TASKS_SEND_H_S(N)       & !     Output
                                           ,NUM_TASKS_SEND_H_N(N)       & !       |
                                           ,NUM_TASKS_SEND_H_W(N)       & !       |
                                           ,NUM_TASKS_SEND_H_E(N)       & !       v
!                                                                           
                                   ,CHILDTASK_H_SAVE(N)%I_LO_SOUTH      &
                                   ,CHILDTASK_H_SAVE(N)%I_HI_SOUTH      &
                                   ,CHILDTASK_H_SAVE(N)%I_LO_NORTH      &
                                   ,CHILDTASK_H_SAVE(N)%I_HI_NORTH      &
                                   ,CHILDTASK_H_SAVE(N)%J_LO_WEST       &
                                   ,CHILDTASK_H_SAVE(N)%J_HI_WEST       &
                                   ,CHILDTASK_H_SAVE(N)%J_LO_EAST       & 
                                   ,CHILDTASK_H_SAVE(N)%J_HI_EAST       &
!
                                   ,CHILDTASK_BNDRY_H_RANKS(N)%SOUTH    &
                                   ,CHILDTASK_BNDRY_H_RANKS(N)%NORTH    &
                                   ,CHILDTASK_BNDRY_H_RANKS(N)%WEST     &
                                   ,CHILDTASK_BNDRY_H_RANKS(N)%EAST     &
!
                                   ,PARENT_4_INDICES_H(N)%I_INDX_SBND   &
                                   ,PARENT_4_INDICES_H(N)%I_INDX_NBND   &
                                   ,PARENT_4_INDICES_H(N)%I_INDX_WBND   &
                                   ,PARENT_4_INDICES_H(N)%I_INDX_EBND   &
                                   ,PARENT_4_INDICES_H(N)%J_INDX_SBND   &
                                   ,PARENT_4_INDICES_H(N)%J_INDX_NBND   &
                                   ,PARENT_4_INDICES_H(N)%J_INDX_WBND   &
                                   ,PARENT_4_INDICES_H(N)%J_INDX_EBND   &
!
                                   ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_SBND  &
                                   ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_NBND  &
                                   ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_WBND  &
                                   ,PARENT_4_WEIGHTS_H(N)%WEIGHTS_EBND)
!
!------------------------------------------------------------------------
!***  The child J extent of words to be transferred from this parent task
!***  to child task NT is one less than the limit used for saving values
!***  of PDB on the child boundary.  We needed to save PDB at one point
!***  further north than the northernmost V in the segment to be able 
!***  to do 4-pt averaging of PDB onto the V points in order to do
!***  hydrostatic updating of V by the parent.  Now indicate that
!***  reduction in the number of points to be transferred.
!------------------------------------------------------------------------
!
!-------------
!***  South H
!-------------
!
        NUM_CHILD_TASKS=NUM_TASKS_SEND_H_S(N)
!
        DO NT=1,NUM_CHILD_TASKS
          CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(NT)=                   &   !<-- Sbndry I limit for transfer to child
            CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NT)-1
!
          NCX=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NT,1)                        !<-- Count of this child task in list of all its fcst tasks
          ITE_CHILD_X=CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA(2,NCX)
          IF(CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NT)==ITE_CHILD_X)THEN            !<-- We do not reduce the area for H data   
            CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(NT)=                 &   !    transfer if the bndry segment reaches
            CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(NT)+1                    !    the physical limit of that bndry
          ENDIF
        ENDDO
!
!-------------
!***  North H
!-------------
!
        NUM_CHILD_TASKS=NUM_TASKS_SEND_H_N(N)
!
        DO NT=1,NUM_CHILD_TASKS
          CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(NT)=                   &  !<-- Nbndry I limit for transfer to child
            CHILDTASK_H_SAVE(N)%I_HI_NORTH(NT)-1
!
          NCX=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NT,1)                        !<-- Count of this child task in list of all its fcst tasks
          ITE_CHILD_X=CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA(2,NCX)
          IF(CHILDTASK_H_SAVE(N)%I_HI_NORTH(NT)==ITE_CHILD_X)THEN           !<-- We do not reduce the area for H data
            CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(NT)=                 &  !    transfer if the bndry segment reaches
            CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(NT)+1                   !    the physical limit of that bndry
          ENDIF
        ENDDO
!
!------------
!***  West H
!------------
!
        NUM_CHILD_TASKS=NUM_TASKS_SEND_H_W(N)
!
        DO NT=1,NUM_CHILD_TASKS
          CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER(NT)=                    &  !<-- Wbndry J limit for transfer to child
            CHILDTASK_H_SAVE(N)%J_HI_WEST(NT)-1
!
          NCX=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NT,1)                         !<-- Count of this child task in list of all its fcst tasks
          JTE_CHILD_X=CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA(4,NCX)   
          IF(CHILDTASK_H_SAVE(N)%J_HI_WEST(NT)==JTE_CHILD_X)THEN            !<-- We do not reduce the area for H data
            CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER(NT)=                  &  !    transfer if the bndry segment reaches
            CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER(NT)+1                    !    the physical limit of that bndry
          ENDIF
        ENDDO
!
!------------
!***  East H
!------------
!
        NUM_CHILD_TASKS=NUM_TASKS_SEND_H_E(N)
!
        DO NT=1,NUM_CHILD_TASKS
          CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER(NT)=                    &  !<-- Ebndry J limit for transfer to child
            CHILDTASK_H_SAVE(N)%J_HI_EAST(NT)-1
!
          NCX=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NT,1)                         !<-- Count of this child task in list of all its fcst tasks
          JTE_CHILD_X=CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA(4,NCX)
          IF(CHILDTASK_H_SAVE(N)%J_HI_EAST(NT)==JTE_CHILD_X)THEN            !<-- We do not reduce the area for H data
            CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER(NT)=                  &  !    transfer if the bndry segment reaches
            CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER(NT)+1                    !    the physical limit of that bndry
          ENDIF
        ENDDO
!
!------------------------------------------------------------
!***  Compute interpolation indices and weights for V points
!------------------------------------------------------------
!
        NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N))                   !<-- # of fcst tasks on this parent's Nth child
!
        CALL PARENT_TO_CHILD_INTERP_FACTORS('V_POINTS'                  &
                                           ,N_CHILD                     &
                                           ,I_PARENT_SW(N)              &
                                           ,J_PARENT_SW(N)              &
                                           ,N_BLEND_V_CHILD(N)          &
!
                                           ,IM_CHILD(N)                 &
                                           ,JM_CHILD(N)                 &
!
                                           ,NUM_CHILD_TASKS             &
                          ,CTASK_LIMITS(MY_DOMAIN_ID)%CHILDREN(N)%DATA  &
                          ,CHILD_RANKS(MY_DOMAIN_ID)%CHILDREN(N)%DATA   &
!
                                           ,CHILD_PARENT_SPACE_RATIO(N) & !       ^
!                                                                                 |
                                           ,ITS,ITE,JTS,JTE             & !       |  
                                           ,IDS,IDE,JDS,JDE             & !     Input
!                                                                        ----------------
                                           ,NUM_TASKS_SEND_V_S(N)       & !     Output
                                           ,NUM_TASKS_SEND_V_N(N)       & !       |
                                           ,NUM_TASKS_SEND_V_W(N)       & !       |
                                           ,NUM_TASKS_SEND_V_E(N)       & !       v
!                                                                         
                                   ,CHILDTASK_V_SAVE(N)%I_LO_SOUTH      &
                                   ,CHILDTASK_V_SAVE(N)%I_HI_SOUTH      &
                                   ,CHILDTASK_V_SAVE(N)%I_LO_NORTH      &
                                   ,CHILDTASK_V_SAVE(N)%I_HI_NORTH      &
                                   ,CHILDTASK_V_SAVE(N)%J_LO_WEST       &
                                   ,CHILDTASK_V_SAVE(N)%J_HI_WEST       &
                                   ,CHILDTASK_V_SAVE(N)%J_LO_EAST       & 
                                   ,CHILDTASK_V_SAVE(N)%J_HI_EAST       &
!
                                   ,CHILDTASK_BNDRY_V_RANKS(N)%SOUTH    &
                                   ,CHILDTASK_BNDRY_V_RANKS(N)%NORTH    &
                                   ,CHILDTASK_BNDRY_V_RANKS(N)%WEST     &
                                   ,CHILDTASK_BNDRY_V_RANKS(N)%EAST     &
!
                                   ,PARENT_4_INDICES_V(N)%I_INDX_SBND   &
                                   ,PARENT_4_INDICES_V(N)%I_INDX_NBND   &
                                   ,PARENT_4_INDICES_V(N)%I_INDX_WBND   &
                                   ,PARENT_4_INDICES_V(N)%I_INDX_EBND   &
                                   ,PARENT_4_INDICES_V(N)%J_INDX_SBND   &
                                   ,PARENT_4_INDICES_V(N)%J_INDX_NBND   &
                                   ,PARENT_4_INDICES_V(N)%J_INDX_WBND   &
                                   ,PARENT_4_INDICES_V(N)%J_INDX_EBND   &
!
                                   ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_SBND  &
                                   ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_NBND  &
                                   ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_WBND  &
                                   ,PARENT_4_WEIGHTS_V(N)%WEIGHTS_EBND)
!
!-----------------------------------------------------------------------
!***  For V point variables, the number of points to be transferred
!***  from parents to their children's boundaries is the same as
!***  the number of computation points (no extensions as is needed
!***  for PDB).
!-----------------------------------------------------------------------
!
        NUM_CHILD_TASKS=FTASKS_DOMAIN(MY_CHILDREN_ID(N))
!
        DO N_CHILD_TASKS=1,NUM_CHILD_TASKS
!
          CHILDTASK_V_SAVE(N)%I_HI_SOUTH_TRANSFER(N_CHILD_TASKS)=       &
            CHILDTASK_V_SAVE(N)%I_HI_SOUTH(N_CHILD_TASKS)
!
          CHILDTASK_V_SAVE(N)%I_HI_NORTH_TRANSFER(N_CHILD_TASKS)=       &
            CHILDTASK_V_SAVE(N)%I_HI_NORTH(N_CHILD_TASKS)
!
          CHILDTASK_V_SAVE(N)%J_HI_WEST_TRANSFER(N_CHILD_TASKS)=        &
            CHILDTASK_V_SAVE(N)%J_HI_WEST(N_CHILD_TASKS)
!
          CHILDTASK_V_SAVE(N)%J_HI_EAST_TRANSFER(N_CHILD_TASKS)=        &
            CHILDTASK_V_SAVE(N)%J_HI_EAST(N_CHILD_TASKS)
!
        ENDDO
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PREPARE_NEST_INTERP_FACTORS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_TO_CHILD_INTERP_FACTORS(FLAG_H_OR_V             &
                                               ,N_CHILD                 &
                                               ,I_PARENT_SW             &
                                               ,J_PARENT_SW             &
                                               ,N_BLEND                 &
!
                                               ,IM_CHILD                &
                                               ,JM_CHILD                &        
!                                                                                 
                                               ,NUM_CHILD_TASKS         &         
                                               ,LIMITS                  &         
                                               ,CHILD_RANKS             &         
!                                                                          
                                               ,CHILD_PARENT_SPACE_RATIO & !     ^
!                                                                                |
                                               ,ITS,ITE,JTS,JTE         & !      |  
                                               ,IDS,IDE,JDS,JDE         & !    Input
!                                                                          --------------
                                               ,NUM_TASKS_SEND_S        & !    Output
                                               ,NUM_TASKS_SEND_N        & !      |
                                               ,NUM_TASKS_SEND_W        & !      |
                                               ,NUM_TASKS_SEND_E        & !      v
!                                                                         
                                               ,I_SAVE_LO_SOUTH         & 
                                               ,I_SAVE_HI_SOUTH         &
                                               ,I_SAVE_LO_NORTH         &
                                               ,I_SAVE_HI_NORTH         &
                                               ,J_SAVE_LO_WEST          &
                                               ,J_SAVE_HI_WEST          &
                                               ,J_SAVE_LO_EAST          &
                                               ,J_SAVE_HI_EAST          &
!
                                               ,LOCAL_TASK_RANK_S       &
                                               ,LOCAL_TASK_RANK_N       &
                                               ,LOCAL_TASK_RANK_W       &
                                               ,LOCAL_TASK_RANK_E       &
!
                                               ,I_INDX_SBND             &
                                               ,I_INDX_NBND             &
                                               ,I_INDX_WBND             &
                                               ,I_INDX_EBND             &
                                               ,J_INDX_SBND             &
                                               ,J_INDX_NBND             &
                                               ,J_INDX_WBND             &
                                               ,J_INDX_EBND             &
!
                                               ,WEIGHTS_SBND            &
                                               ,WEIGHTS_NBND            &
                                               ,WEIGHTS_WBND            &
                                               ,WEIGHTS_EBND )
!
!-----------------------------------------------------------------------
!***  Parent components compute various indices, weights, etc.
!***  needed to generate boundary point data for the given
!***  child throughout the upcoming forecast.
!***  Only parent tasks execute this routine.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: I_PARENT_SW,J_PARENT_SW          &  !<-- SW corner of nest lies on this I,J of parent
                                      ,IM_CHILD,JM_CHILD                &  !<-- Horizontal dimensions of nest domain
                                      ,N_BLEND                          &  !<-- Width (in rows) of boundary's blending region
                                      ,N_CHILD                          &  !<-- Rank of this child in list of children
                                      ,NUM_CHILD_TASKS                     !<-- # of fcst tasks on the child's domain
! 
      INTEGER(kind=KINT),INTENT(IN) :: ITE,ITS,JTE,JTS                  &  !<-- Index limits on parent task subdomain
                                      ,IDE,IDS,JDE,JDS                     !<-- Full dimensions of parent domain
!
      INTEGER(kind=KINT),DIMENSION(0:NUM_CHILD_TASKS-1),INTENT(IN) ::   &  
                                                            CHILD_RANKS    !<-- Child fcst task ranks in parent-child intracommunicator
!
      INTEGER(kind=KINT),DIMENSION(1:4,1:NUM_CHILD_TASKS),INTENT(IN) :: &
                                                                 LIMITS    !<-- ITS,ITE,JTS,JTE on each task of the child
!
      REAL(kind=KFPT),INTENT(IN) :: CHILD_PARENT_SPACE_RATIO               !<-- Ratio of nest grid increment to parent's increment
!
      CHARACTER(*),INTENT(IN) :: FLAG_H_OR_V                               !<-- Are we dealing with H or V child boundary points?
!
      INTEGER(kind=KINT),INTENT(OUT) :: NUM_TASKS_SEND_S                &  !<-- # of child tasks with S bndry segments on this parent task
                                       ,NUM_TASKS_SEND_N                &  !<-- # of child tasks with N bndry segments on this parent task
                                       ,NUM_TASKS_SEND_W                &  !<-- # of child tasks with W bndry segments on this parent task
                                       ,NUM_TASKS_SEND_E                   !<-- # of child tasks with E bndry segments on this parent task
!
      INTEGER(kind=KINT),DIMENSION(NUM_CHILD_TASKS),INTENT(OUT) ::      &
                                                     I_SAVE_LO_SOUTH    &  !<-- Child tasks' westernmost Sbndry I's on this parent task
                                                    ,I_SAVE_HI_SOUTH    &  !<-- Child tasks' easternmost Sbndry I's on this parent task
                                                    ,I_SAVE_LO_NORTH    &  !<-- Child tasks' westernmost Nbndry I's on this parent task
                                                    ,I_SAVE_HI_NORTH    &  !<-- Child tasks' easternmost Nbndry I's on this parent task
                                                    ,J_SAVE_LO_WEST     &  !<-- Child tasks' southernmost Wbndry J's on this parent task
                                                    ,J_SAVE_HI_WEST     &  !<-- Child tasks' northernmost Wbndry J's on this parent task
                                                    ,J_SAVE_LO_EAST     &  !<-- Child tasks' southernmost Ebndry J's on this parent task
                                                    ,J_SAVE_HI_EAST        !<-- Child tasks' northernmost Ebndry J's on this parent task
!
      INTEGER(kind=KINT),DIMENSION(NUM_CHILD_TASKS,2),INTENT(OUT) ::    &
                                                    LOCAL_TASK_RANK_S   &  !<-- Child task counts/ranks with S bndry on this parent task
                                                   ,LOCAL_TASK_RANK_N   &  !<-- Child task counts/ranks with N bndry on this parent task
                                                   ,LOCAL_TASK_RANK_W   &  !<-- Child task counts/ranks with W bndry on this parent task
                                                   ,LOCAL_TASK_RANK_E      !<-- Child task counts/ranks with E bndry on this parent task
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER,INTENT(INOUT) ::      &
                                                          I_INDX_SBND   &  !<-- Parent I west/east of child south boundary point 
                                                         ,I_INDX_NBND   &  !<-- Parent I west/east of child north boundary point
                                                         ,I_INDX_WBND   &  !<-- Parent I west/east of child west boundary point
                                                         ,I_INDX_EBND   &  !<-- Parent I west/east of child east boundary point
                                                         ,J_INDX_SBND   &  !<-- Parent J south/north of child south boundary point
                                                         ,J_INDX_NBND   &  !<-- Parent J south/north of child north boundary point
                                                         ,J_INDX_WBND   &  !<-- Parent J south/north of child west boundary point
                                                         ,J_INDX_EBND      !<-- Parent J south/north of child east boundary point
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER,INTENT(INOUT) ::         &
                                                         WEIGHTS_SBND   &  !<-- Sbndry bilinear interp wghts for 4 surrounding parent points
                                                        ,WEIGHTS_NBND   &  !<-- Nbndry bilinear interp wghts for 4 surrounding parent points
                                                        ,WEIGHTS_WBND   &  !<-- Wbndry bilinear interp wghts for 4 surrounding parent points
                                                        ,WEIGHTS_EBND      !<-- Ebndry bilinear interp wghts for 4 surrounding parent points
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I_CHILD,IM_END                              &
                           ,J_CHILD,JM_END                              &
                           ,KOUNT_I,KOUNT_J                             &
                           ,N,N_ADD,NC                                  &
                           ,NC_LAST_S,NC_LAST_N,NC_LAST_W,NC_LAST_E     &
                           ,RATIO_P_C
!
      INTEGER(kind=KINT),DIMENSION(1:NUM_CHILD_TASKS) :: I_LIMIT_LO     &
                                                        ,I_LIMIT_HI     &
                                                        ,ITS_CHILD      &
                                                        ,ITE_CHILD      &
                                                        ,J_LIMIT_LO     &
                                                        ,J_LIMIT_HI     &
                                                        ,JTS_CHILD      &
                                                        ,JTE_CHILD      &
                                                        ,NC_HOLD_S      &
                                                        ,NC_HOLD_N      &
                                                        ,NC_HOLD_W      &
                                                        ,NC_HOLD_E
!
      REAL(kind=KFPT) :: ADD_INC,ARG1,ARG2                              &
                        ,R_ITS,R_ITE,R_IEND,R_JTS,R_JTE,R_JEND       
!
      REAL(kind=KFPT) :: PARENT_I_CHILD_EBND,PARENT_I_CHILD_WBND        &
                        ,PARENT_J_CHILD_NBND,PARENT_J_CHILD_SBND        &
                        ,PARENT_S_TASK_LIM_ON_NEST                      &
                        ,PARENT_W_TASK_LIM_ON_NEST                      &
                        ,RATIO_C_P                                      &
                        ,REAL_I_PARENT,REAL_I_START                     &
                        ,REAL_J_PARENT,REAL_J_START                     &
                        ,RECIP_SUM
!
      REAL(kind=KFPT) :: WEIGHT_NE,WEIGHT_NW,WEIGHT_SE,WEIGHT_SW
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RATIO_C_P=CHILD_PARENT_SPACE_RATIO                                   !<-- Child-to-Parent gridspace ratio
      RATIO_P_C=NINT(1./RATIO_C_P)                                         !<-- Parent-to-Child gridspace ratio
!
!-----------------------------------------------------------------------
!***  Create the Real index limits on the parent grid across which
!***  the children's boundary point values will be computed.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***                      !!!!! NOTE !!!!!
!
!***  For the purpose of handling child boundaries, parent tasks will
!***  "BEGIN" directly on their southernmost/westernmost H or V points.
!***  Each parent task covers the gap between itself and the next task
!***  on the parent grid in each direction.
!***  This means that if a child south boundary point lies exactly on 
!***  a parent task point that itself is on the westernmost side of
!***  that parent task's integration subdomain then that child point
!***  will be considered to lie on both that parent task and the
!***  parent task to the west simply because it is the intersection
!***  of the regions managed by both of those parent tasks.
!***  This same notion applies for all other directions and sides.
!-----------------------------------------------------------------------
!
      R_ITE =REAL(ITE)                                                     !<-- REAL Iend of parent task's subdomain
!
      R_JTE =REAL(JTE)                                                     !<-- REAL Jend of parent task's subdomain
!
!-----------------------------------------------------------------------
!***  Because each parent gridpoint covers the gap to the next parent
!***  gridpoint as explained above, increase the search limit for
!***  child boundary points.  That increase would be 1 for both H and V
!***  but due to the nature of the B-Grid layout and the fact that
!***  the I index of child V points on the west boundary and the
!***  J index of the child V points on the south boundary have smaller
!***  grid index values in terms of the parent indices, we must search
!***  for child H points 1/2+0.5*(space_ratio) grid increments further
!***  than for child V points in order to reach the same actual position.
!-----------------------------------------------------------------------
!
!***  In this diagram the H's and V's are points on the parent task's
!***  subdomain while the h's and v's are points on a nest.  It shows
!***  how each parent point must look eastward.  The same goes for
!***  looking northwward.  A parent/nest ratio of 3:1 is used in this
!***  diagram.
!
!-----------------------------------------------------------------------
!
!     H           H           H
!
!
!
!           V           V
!                       v
!                 h   h   h   h
!
!     H           H           H
!
!     -----------> ----> ->
!           1       1/2 1/6
!     ^
!     |
! This parent
! gridpoint
! must cover
! area to the
! next H.
! But V with
! the same I 
! as the next H
! is 1.5 farther
! than this H.
! If nest v at
! 1.5 past this
! H is on the east
! bndry of the nest
! then the east h
! on the bndry is
! 1+1/2+1/6.
! That is how
! far we must
! scan from
! this H.
!-----------------------------------------------------------------------
!
      IF(FLAG_H_OR_V=='H_POINTS')THEN
!       ADD_INC=1.5
        ADD_INC=1.5+0.5*RATIO_C_P+EPS

      ELSE
        ADD_INC=1.0
      ENDIF
!
!-----------------------------------------------------------------------
!
      DO N=1,NUM_CHILD_TASKS                                               
        I_SAVE_LO_SOUTH(N)=-1
        I_SAVE_LO_NORTH(N)=-1
        J_SAVE_LO_WEST (N)=-1
        J_SAVE_LO_EAST (N)=-1
!
        NC_HOLD_S(N)=-1
        NC_HOLD_N(N)=-1
        NC_HOLD_W(N)=-1
        NC_HOLD_E(N)=-1
      ENDDO
!
!-----------------------------------------------------------------------
!***  What are the child I and J index limits of any sections of its
!***  (the child's) boundary that lie within a parent task's subdomain?
!
!***  What are the indices of the four parent gridpoints surrounding
!***  each child boundary point?
!
!***  What are the bilinear weights associated with each of the four
!***  surrounding parent points to obtain the child boundary point?
!
!***  The parent will use these pieces of information to interpolate
!***  from its grid to its children's boundary points.
!----------------------------------------------------------------------- 
!
!-----------------------------------------------------------
!**********************  NOTE  *****************************
!-----------------------------------------------------------
!***  We assume that the WIDTH of the blending region of
!***  a child's boundary does NOT cross the border between
!***  two parent tasks' subdomains.
!-----------------------------------------------------------
!
      IF(FLAG_H_OR_V=='H_POINTS')THEN
        PARENT_J_CHILD_SBND=REAL(J_PARENT_SW)                              !<-- J index of parent H for child's south H boundary
        PARENT_J_CHILD_NBND=PARENT_J_CHILD_SBND+(JM_CHILD-1)*RATIO_C_P     !<-- J index of parent H for child's north H boundary
        PARENT_I_CHILD_WBND=REAL(I_PARENT_SW)                              !<-- I index of parent H for child's west H boundary
        PARENT_I_CHILD_EBND=PARENT_I_CHILD_WBND+(IM_CHILD-1)*RATIO_C_P     !<-- I index of parent H for child's east H boundary
        IM_END=IM_CHILD
        JM_END=JM_CHILD
        N_ADD=1                                                            !<-- Blending region along child's boundary
                                                                           !    increased by 1 row to allow 4-pt averaging of PD.
!
      ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
        PARENT_J_CHILD_SBND=REAL(J_PARENT_SW)-0.5+RATIO_C_P*0.5            !<-- J index of parent V for child's south V boundary
        PARENT_J_CHILD_NBND=PARENT_J_CHILD_SBND+(JM_CHILD-2)*RATIO_C_P     !<-- J index of parent V for child's north V boundary
        PARENT_I_CHILD_WBND=REAL(I_PARENT_SW)-0.5+RATIO_C_P*0.5            !<-- I index of parent V for child's west V boundary
        PARENT_I_CHILD_EBND=PARENT_I_CHILD_WBND+(IM_CHILD-2)*RATIO_C_P     !<-- I index of parent V for child's east V boundary
        IM_END=IM_CHILD-1
        JM_END=JM_CHILD-1
        N_ADD=0                                                            !<-- Blending region along child's boundary
                                                                           !    increased only for mass points (for PD averaging)
      ENDIF
!
!-----------------------------------------------------------------------
!***  Check to see if the child domain is too near to the parent
!***  domain's boundary.
!-----------------------------------------------------------------------
!
      IF(PARENT_J_CHILD_SBND<=JDS+2)THEN
        WRITE(0,20221)N_CHILD,MY_DOMAIN_ID
        WRITE(0,20222)PARENT_J_CHILD_SBND,JDS,FLAG_H_OR_V
20221   FORMAT(' Child #',I2,' is within 2 points of the south'         &
              ,' boundary of domain #',I2)
20222   FORMAT(' Parent J of child Sbndry=',e12.5,' parent jds=',i3,' flag_h_or_v=',a)
        WRITE(0,*)' ABORTING!!'
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      IF(PARENT_J_CHILD_NBND>=JDE-2)THEN
        WRITE(0,20223)N_CHILD,MY_DOMAIN_ID
        WRITE(0,20224)PARENT_J_CHILD_NBND,JDE,FLAG_H_OR_V
20223   FORMAT(' Child #',I2,' is within 2 points of the north'         &
              ,' boundary of domain #',I2)
20224   FORMAT(' Parent J of child Nbndry=',e12.5,' parent jde=',i3,' flag_h_or_v=',a)
        WRITE(0,*)' ABORTING!!'
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      IF(PARENT_I_CHILD_WBND<=IDS+2)THEN
        WRITE(0,20225)N_CHILD,MY_DOMAIN_ID
        WRITE(0,20226)PARENT_I_CHILD_WBND,IDS,FLAG_H_OR_V
20225   FORMAT(' Child #',I2,' is within 2 points of the west'          &
              ,' boundary of domain #',I2)
20226   FORMAT(' Parent I of child Wbndry=',e12.5,' parent ids=',i3,' flag_h_or_v=',a)
        WRITE(0,*)' ABORTING!!'
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
      IF(PARENT_I_CHILD_EBND>=IDE+2)THEN
        WRITE(0,20227)N_CHILD,MY_DOMAIN_ID
        WRITE(0,20228)PARENT_I_CHILD_EBND,IDE,FLAG_H_OR_V
20227   FORMAT(' Child #',I2,' is within 2 points of the east'          &
              ,' boundary of domain #',I2)
20228   FORMAT(' Parent I of child Ebndry=',e12.5,' parent ide=',i3,' flag_h_or_v=',a)
        WRITE(0,*)' ABORTING!!'
        CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
      ENDIF
!
!-----------------------------------------------------------------------
!
      DO N=1,NUM_CHILD_TASKS                                               !<-- Loop through forecast tasks on the child domain
        ITS_CHILD(N)=LIMITS(1,N)                                           !<-- ITS on this child task
        ITE_CHILD(N)=LIMITS(2,N)                                           !<-- ITE on this child task
        JTS_CHILD(N)=LIMITS(3,N)                                           !<-- JTS on this child task
        JTE_CHILD(N)=LIMITS(4,N)                                           !<-- JTE on this child task
        I_LIMIT_LO(N)=MAX(ITS_CHILD(N)-2,1)                                !<-- Starting I's for each child task on N/S bndries (2-pt halo)
        I_LIMIT_HI(N)=MIN(ITE_CHILD(N)+2+N_ADD,IM_END)                     !<-- Ending I's for each child task on N/S bndries (2-pt halo)
        J_LIMIT_LO(N)=MAX(JTS_CHILD(N)-2,1)                                !<-- Starting J's for each child task on W/E bndries (2-pt halo)
        J_LIMIT_HI(N)=MIN(JTE_CHILD(N)+2+N_ADD,JM_END)                     !<-- Ending J's for each child task on W/E bndries (2-pt halo)
!
!-----------------------------------------------------------------------
!***  If the northernmost/easternmost extra row of H bndry points
!***  on a nest task coincides with the southern/western boundary 
!***  of a parent task then that parent task will not be associated
!***  with the nest since no bndry V points would be seen by the
!***  parent task.
!-----------------------------------------------------------------------
!
        IF(FLAG_H_OR_V=='H_POINTS')THEN
!
          PARENT_S_TASK_LIM_ON_NEST=REAL(JTS-J_PARENT_SW)*RATIO_P_C+1      !<-- South limit of parent task w/r to nest J
          IF(J_LIMIT_HI(N)-PARENT_S_TASK_LIM_ON_NEST<=0.5)THEN
            J_LIMIT_HI(N)=J_LIMIT_HI(N)-1
          ENDIF
!
          PARENT_W_TASK_LIM_ON_NEST=REAL(ITS-I_PARENT_SW)*RATIO_P_C+1      !<-- West limit of parent task w/r to nest I
          IF(I_LIMIT_HI(N)-PARENT_W_TASK_LIM_ON_NEST<=0.5)THEN
            I_LIMIT_HI(N)=I_LIMIT_HI(N)-1
          ENDIF
        ENDIF
!
      ENDDO
!
!-----------------------------------------------------
!-----------------------------------------------------
!***  Child's southern/northern boundaries
!
!***  Work eastward along these boundaries
!***  and save the basic indices and weights
!***  needed by the parent.
!-----------------------------------------------------
!-----------------------------------------------------
!
      NC_LAST_S=-1
      NC_LAST_N=-1
!
      NUM_TASKS_SEND_S=0
      NUM_TASKS_SEND_N=0
!
      IF(FLAG_H_OR_V=='H_POINTS')THEN
        R_ITS=REAL(ITS)-EPS                                                !<-- REAL Istart of parent task's subdomain for H on B grid
      ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
        R_ITS=REAL(ITS-0.5)-EPS                                            !<-- REAL Istart of parent task's subdomain for V on B grid
      ENDIF
!
      ARG1=REAL(ITE)+ADD_INC
      ARG2=REAL(IDE)
      R_IEND=MIN(ARG1,ARG2)-2.*EPS                                         !<-- REAL Iend of parent task's region for child N/S boundaries
!
!-----------------------------------------------------
!
      REAL_I_START=PARENT_I_CHILD_WBND                                     !<-- I index of parent H for child's west H boundary
!
!-----------------------------------------------------------------------
      i_loop: DO I_CHILD=1,IM_END                                          !<-- Loop over child I's across its South/North boundaries
!-----------------------------------------------------------------------
!
        REAL_I_PARENT=REAL_I_START+(I_CHILD-1)*RATIO_C_P                   !<-- Parent I index coinciding with child domain point
!
!-----------------------------------------------------------------------
!
!       i_block: IF(REAL_I_PARENT>=R_ITS.AND.REAL_I_PARENT<=R_IEND)THEN    !<-- Column (I) of child's S/N bndry point lies on parent task?
        i_block: IF(REAL_I_PARENT>=R_ITS.AND.REAL_I_PARENT< R_IEND)THEN    !<-- Column (I) of child's S/N bndry point lies on parent task?
!
!-----------
!-----------
!***  South
!-----------
!-----------
!
          REAL_J_START=PARENT_J_CHILD_SBND                                 !<-- J index of parent H for child's south H boundary
          KOUNT_J=0
!
          IF(FLAG_H_OR_V=='H_POINTS')THEN
            R_JTS=REAL(JTS)-EPS                                            !<-- REAL Jstart of parent task's subdomain for H on B grid
            R_JEND=REAL(MIN(JTE+1,JDE))-EPS                                !<-- Allow search for child H boundary points to go into
                                                                           !    the parent's halo.
          ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
            R_JTS =REAL(JTS-0.5)-EPS                                       !<-- REAL Jstart of parent task's subdomain for V on B grid
                                                                           !    (-0.5 yields same location on grid as R_JTS for H).
            R_JEND=REAL(MIN(REAL(JTE+0.5),REAL(JDE)))-EPS                  !<-- Use JTE+0.5 to stop V search at the row of the
                                                                           !    northernmost H that is searched; this ensures that
                                                                           !    a parent will send both H and V boundary points.
          ENDIF
!
!-----------------------------------------------------------------------
!     
          J_CHILD=1
!
!-----------------------------------------------------------------------
!***  Which child task contains this (I_CHILD,J_CHILD) point?
!***  Find out then save the I limits of that task's boundary
!***  segment on this parent task so that the parent task
!***  will know exactly which words to send to the child task.
!***  Also remember that the NMM-B boundary update routines go
!***  two points into the halo which means that two child
!***  tasks will share some boundary points on the parent.
!-----------------------------------------------------------------------
!
          child_ij_s: IF(REAL_J_START >=R_JTS.AND.REAL_J_START < R_JEND)THEN  !<-- Does parent task see this row of its child?
!
            DO NC=1,NUM_CHILD_TASKS                                        !<-- Loop through all tasks on child domain
!
              IF(I_CHILD>=I_LIMIT_LO(NC).AND.                           &  !<-- Does current child boundary point on this
                 I_CHILD<=I_LIMIT_HI(NC)                                &  !    parent task lie on child task "NC"?
                 .AND.                                                  &  !
                 J_CHILD>=JTS_CHILD(NC).AND.                            &  !
                 J_CHILD<=JTE_CHILD(NC))THEN
!
                IF(NC>NC_LAST_S)THEN                                       !<-- Encountered a new child task holding this S bndry point?
                  NUM_TASKS_SEND_S=NUM_TASKS_SEND_S+1                      !<-- Then increment the S bndry counter of the child tasks
                  LOCAL_TASK_RANK_S(NUM_TASKS_SEND_S,1)=NC                 !<-- This child task's count in list of fcst tasks
                  LOCAL_TASK_RANK_S(NUM_TASKS_SEND_S,2)=CHILD_RANKS(NC-1)  !<-- This child task's local rank in p-c intracomm
                  NC_LAST_S=NC
                  NC_HOLD_S(NC)=NUM_TASKS_SEND_S
                ENDIF
!
                IF(I_SAVE_LO_SOUTH(NC_HOLD_S(NC))<0)THEN
                  I_SAVE_LO_SOUTH(NC_HOLD_S(NC))=I_CHILD                   !<-- Save westernmost Sbndry I of child task NC
                                                                           !    that is on this parent task.
                ENDIF
                I_SAVE_HI_SOUTH(NC_HOLD_S(NC))=I_CHILD                     !<-- Save easternmost Sbndry I of child task NC
                                                                           !    that is on this parent task.
!
              ENDIF
! 
            ENDDO
! 
!-----------------------------------------------------------------------
!
            j_south: DO J_CHILD=1,N_BLEND+N_ADD                            !<-- Blending region along child's southern boundary
!
              KOUNT_J=KOUNT_J+1
              REAL_J_PARENT=REAL_J_START+(KOUNT_J-1)*RATIO_C_P             !<-- REAL parent J for this child's J
!
              I_INDX_SBND(I_CHILD,J_CHILD,1)=INT(REAL_I_PARENT+EPS)        !<-- Parent I west of child's south boundary point
              I_INDX_SBND(I_CHILD,J_CHILD,2)=INT(REAL_I_PARENT+EPS)+1      !<-- Parent I east of child's south boundary point
              J_INDX_SBND(I_CHILD,J_CHILD,1)=INT(REAL_J_PARENT+EPS)        !<-- Parent J south of child's south boundary point
              J_INDX_SBND(I_CHILD,J_CHILD,2)=INT(REAL_J_PARENT+EPS)+1      !<-- Parent J north of child's south boundary point
!
              WEIGHT_SW=(I_INDX_SBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (J_INDX_SBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_SE=(REAL_I_PARENT-I_INDX_SBND(I_CHILD,J_CHILD,1))* &
                        (J_INDX_SBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_NW=(I_INDX_SBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (REAL_J_PARENT-J_INDX_SBND(I_CHILD,J_CHILD,1))
              WEIGHT_NE=(REAL_I_PARENT-I_INDX_SBND(I_CHILD,J_CHILD,1))* &
                        (REAL_J_PARENT-J_INDX_SBND(I_CHILD,J_CHILD,1))
!
              RECIP_SUM=1./(WEIGHT_SW+WEIGHT_SE+WEIGHT_NW+WEIGHT_NE)
!
              WEIGHTS_SBND(I_CHILD,J_CHILD,INDX_SW)=WEIGHT_SW*RECIP_SUM    !<-- Bilin interp wght of parent point SW of child bndry point
              WEIGHTS_SBND(I_CHILD,J_CHILD,INDX_SE)=WEIGHT_SE*RECIP_SUM    !<-- Bilin interp wght of parent point SE of child bndry point
              WEIGHTS_SBND(I_CHILD,J_CHILD,INDX_NW)=WEIGHT_NW*RECIP_SUM    !<-- Bilin interp wght of parent point NW of child bndry point
              WEIGHTS_SBND(I_CHILD,J_CHILD,INDX_NE)=WEIGHT_NE*RECIP_SUM    !<-- Bilin interp wght of parent point NE of child bndry point
!
            ENDDO j_south
! 
!-----------------------------------------------------------------------
          ENDIF child_ij_s
!-----------------------------------------------------------------------
!
!
!-----------
!-----------
!***  North
!-----------
!-----------
! 
          REAL_J_START=PARENT_J_CHILD_NBND
          KOUNT_J=0
!
          IF(FLAG_H_OR_V=='H_POINTS')THEN
            R_JTS=REAL(JTS)+EPS                                            !<-- REAL Jstart of parent task's subdomain for H on B grid
            R_JEND=REAL(MIN(JTE+1,JDE))+EPS                                !<-- Allow search for child H boundary points to go into
                                                                           !    the parent's halo.
          ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
            R_JTS =REAL(JTS-0.5)+EPS                                       !<-- REAL Jstart of parent task's subdomain for V on B grid
                                                                           !    (-0.5 yields same location on grid as R_JTS for H).
            R_JEND=REAL(MIN(REAL(JTE+0.5),REAL(JDE)))+EPS                  !<-- Use JTE+0.5 to stop V search at the row of the
                                                                           !    northernmost H that is searched; this ensures that
                                                                           !    a parent will send both H and V boundary points.
          ENDIF
!
!-----------------------------------------------------------------------
!
          J_CHILD=JM_END                                                   
!
!-----------------------------------------------------------------------
!
          child_ij_n: IF(REAL_J_START >=R_JTS.AND.REAL_J_START < R_JEND)THEN  !<-- Does parent task see this row of its child?
!
!-----------------------------------------------------------------------
!
!-------------------------------------------------------------
!***  Find the child tasks and their relevant limits
!***  along the child's northern boundary.
!-------------------------------------------------------------
!
            DO NC=1,NUM_CHILD_TASKS                                        !<-- Loop through all tasks on child domain
              IF(I_CHILD>=I_LIMIT_LO(NC).AND.                           &  !<-- Does current child boundary point on this
                 I_CHILD<=I_LIMIT_HI(NC)                                &  !    parent task lie on child task "NC"?
                 .AND.                                                  &  !
                 J_CHILD>=JTS_CHILD(NC).AND.                            &  !
                 J_CHILD<=JTE_CHILD(NC))THEN
!
                IF(NC>NC_LAST_N)THEN                                       !<-- Have we encountered a new child task holding this N bndry?
                  NUM_TASKS_SEND_N=NUM_TASKS_SEND_N+1                      !<-- Then increment the N bndry counter of the child tasks
                  LOCAL_TASK_RANK_N(NUM_TASKS_SEND_N,1)=NC                 !<-- This child task's count in list of fcst tasks
                  LOCAL_TASK_RANK_N(NUM_TASKS_SEND_N,2)=CHILD_RANKS(NC-1)  !<-- This child task's local rank in p-c intracomm
                  NC_LAST_N=NC
                  NC_HOLD_N(NC)=NUM_TASKS_SEND_N
                ENDIF
!
                IF(I_SAVE_LO_NORTH(NC_HOLD_N(NC))<0)THEN
                  I_SAVE_LO_NORTH(NC_HOLD_N(NC))=I_CHILD                   !<-- Save westernmost Nbndry I of child task NC
                                                                           !    that is on this parent task.
                ENDIF
                I_SAVE_HI_NORTH(NC_HOLD_N(NC))=I_CHILD                     !<-- Save easternmost Nbndry I of child task NC
                                                                           !    that is on this parent task.
! 
              ENDIF
! 
            ENDDO
! 
!-----------------------------------------------------------------------
!
            j_north: DO J_CHILD=JM_END,JM_END-N_BLEND+1-N_ADD,-1           !<-- Blending region of child's northern boundary
!
!-----------------------------------------------------------------------
!
              KOUNT_J=KOUNT_J+1
              REAL_J_PARENT=REAL_J_START-(KOUNT_J-1)*RATIO_C_P             !<-- REAL parent J for this child's J
!
              I_INDX_NBND(I_CHILD,J_CHILD,1)=INT(REAL_I_PARENT+EPS)        !<-- Parent I west of child's north boundary point
              I_INDX_NBND(I_CHILD,J_CHILD,2)=INT(REAL_I_PARENT+EPS)+1      !<-- Parent I east of child's north boundary point
              J_INDX_NBND(I_CHILD,J_CHILD,1)=INT(REAL_J_PARENT+EPS)        !<-- Parent J south of child's north boundary point
              J_INDX_NBND(I_CHILD,J_CHILD,2)=INT(REAL_J_PARENT+EPS)+1      !<-- Parent J north of child's north boundary point
!
              WEIGHT_SW=(I_INDX_NBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (J_INDX_NBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_SE=(REAL_I_PARENT-I_INDX_NBND(I_CHILD,J_CHILD,1))* &
                        (J_INDX_NBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_NW=(I_INDX_NBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (REAL_J_PARENT-J_INDX_NBND(I_CHILD,J_CHILD,1))
              WEIGHT_NE=(REAL_I_PARENT-I_INDX_NBND(I_CHILD,J_CHILD,1))* &
                        (REAL_J_PARENT-J_INDX_NBND(I_CHILD,J_CHILD,1))
!
              RECIP_SUM=1./(WEIGHT_SW+WEIGHT_SE+WEIGHT_NW+WEIGHT_NE)
!
              WEIGHTS_NBND(I_CHILD,J_CHILD,INDX_SW)=WEIGHT_SW*RECIP_SUM    !<-- Interp wght of parent point SW of child bndry point
              WEIGHTS_NBND(I_CHILD,J_CHILD,INDX_SE)=WEIGHT_SE*RECIP_SUM    !<-- Interp wght of parent point SE of child bndry point
              WEIGHTS_NBND(I_CHILD,J_CHILD,INDX_NW)=WEIGHT_NW*RECIP_SUM    !<-- Interp wght of parent point NW of child bndry point
              WEIGHTS_NBND(I_CHILD,J_CHILD,INDX_NE)=WEIGHT_NE*RECIP_SUM    !<-- Interp wght of parent point NE of child bndry point
!
            ENDDO j_north
!
!-----------------------------------------------------------------------
          ENDIF child_ij_n
!-----------------------------------------------------------------------
!
        ENDIF i_block
!
!-----------------------------------------------------------------------
!
      ENDDO i_loop
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------
!-----------------------------------------------------
!***  Child's western/eastern boundaries
!
!***  Work northward along these boundaries
!***  and save the basic indices and weights
!***  needed by the parent.
!-----------------------------------------------------
!-----------------------------------------------------
!
      NC_LAST_W=-1
      NC_LAST_E=-1
!
      NUM_TASKS_SEND_W=0                                                   !<-- Parent task sends to this many child tasks on W bndry
      NUM_TASKS_SEND_E=0                                                   !<-- Parent task sends to this many child tasks on E bndry
!
      IF(FLAG_H_OR_V=='H_POINTS')THEN
        R_JTS=REAL(JTS)-EPS                                                !<-- REAL Jstart of parent task's subdomain for H on B grid
      ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
        R_JTS=REAL(JTS-0.5)-EPS                                            !<-- REAL Jstart of parent task's subdomain for V on B grid
      ENDIF
!
      ARG1=REAL(JTE)+ADD_INC
      ARG2=REAL(JDE)
      R_JEND=MIN(ARG1,ARG2)-2.*EPS                                         !<-- REAL Jend of parent task's region for child W/E boundaries
!
      REAL_J_START=PARENT_J_CHILD_SBND                                     !<-- J index of parent H for child's south H boundary
!
!-----------------------------------------------------------------------
      j_loop: DO J_CHILD=1,JM_END                                          !<-- Loop through child J's across its W/E boundaries
!-----------------------------------------------------------------------

        REAL_J_PARENT=REAL_J_START+(J_CHILD-1)*RATIO_C_P                   !<-- Parent J index coinciding with child domain point
!
!-----------------------------------------------------------------------
!
!       j_block: IF(REAL_J_PARENT>=R_JTS.AND.REAL_J_PARENT<=R_JEND)THEN    !<-- Row (J) of child's W/E bndry point lies on parent task?
        j_block: IF(REAL_J_PARENT>=R_JTS.AND.REAL_J_PARENT< R_JEND)THEN    !<-- Row (J) of child's W/E bndry point lies on parent task?
!
!----------
!----------
!***  West
!----------
!----------
!
          REAL_I_START=PARENT_I_CHILD_WBND
          KOUNT_I=0
!
          IF(FLAG_H_OR_V=='H_POINTS')THEN
            R_ITS=REAL(ITS)-EPS                                            !<-- REAL Istart of parent task's subdomain for H on B grid
            R_IEND=REAL(MIN(ITE+1,IDE))-EPS                                !<-- Allow search for child H boundary points to go into
                                                                           !    the parent's halo.
          ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
            R_ITS =REAL(ITS-0.5)-EPS                                       !<-- REAL Istart of parent task's subdomain for V on B grid
                                                                           !    (-0.5 yields same location on grid as R_JTS for H).
            R_IEND=REAL(MIN(REAL(ITE+0.5),REAL(IDE)))-EPS                  !<-- Use ITE+0.5 to stop V search at the row of the
                                                                           !    northernmost H that is searched; this ensures that
                                                                           !    a parent will send both H and V boundary points.
          ENDIF
!
!-----------------------------------------------------------------------
!
          I_CHILD=1
!
!-----------------------------------------------------------------------
!
          child_ij_w: IF(REAL_I_START >=R_ITS.AND.REAL_I_START < R_IEND)THEN  !<-- Does parent task see this column of its child?
!
!-----------------------------------------------------------------------
!
!-------------------------------------------------------------
!***  Find the child tasks and their relevant limits
!***  along the child's western boundary.
!-------------------------------------------------------------
!
            DO NC=1,NUM_CHILD_TASKS                                        !<-- Loop through all tasks on child domain
!
              IF(J_CHILD>=J_LIMIT_LO(NC).AND.                           &  !<-- Does current child boundary point on this
                 J_CHILD<=J_LIMIT_HI(NC)                                &  !    parent task lie on child task "NC"?
                 .AND.                                                  &  !
                 I_CHILD>=ITS_CHILD(NC).AND.                            &  !
                 I_CHILD<=ITE_CHILD(NC))THEN
!
                IF(NC>NC_LAST_W)THEN                                       !<-- Have we encountered a new child task holding this W bndry?
                  NUM_TASKS_SEND_W=NUM_TASKS_SEND_W+1                      !<-- Then increment the W bndry counter of the child tasks
                  LOCAL_TASK_RANK_W(NUM_TASKS_SEND_W,1)=NC                 !<-- This child task's count in list of fcst tasks
                  LOCAL_TASK_RANK_W(NUM_TASKS_SEND_W,2)=CHILD_RANKS(NC-1)  !<-- This child task's local rank in p-c intracomm
                  NC_LAST_W=NC
                  NC_HOLD_W(NC)=NUM_TASKS_SEND_W
                ENDIF
!
                IF(J_SAVE_LO_WEST(NC_HOLD_W(NC))<0)THEN
                  J_SAVE_LO_WEST(NC_HOLD_W(NC))=J_CHILD                    !<-- Save southernmost Wbndry J of child task NC
                                                                           !    that is on this parent task.
                ENDIF
                J_SAVE_HI_WEST(NC_HOLD_W(NC))=J_CHILD                      !<-- Save northernmost Wbndry J of child task NC
                                                                           !    that is on this parent task.
!
              ENDIF
!
            ENDDO
!
!-------------------------------------------------------------
            i_west: DO I_CHILD=1,N_BLEND+N_ADD                             !<-- Blending region of child's western boundary
!-------------------------------------------------------------
!
              KOUNT_I=KOUNT_I+1
              REAL_I_PARENT=REAL_I_START+(KOUNT_I-1)*RATIO_C_P             !<-- REAL parent I for this child's I
!
              I_INDX_WBND(I_CHILD,J_CHILD,1)=INT(REAL_I_PARENT+EPS)        !<-- Parent I west of child's west boundary point
              I_INDX_WBND(I_CHILD,J_CHILD,2)=INT(REAL_I_PARENT+EPS)+1      !<-- Parent I east of child's west boundary point
              J_INDX_WBND(I_CHILD,J_CHILD,1)=INT(REAL_J_PARENT+EPS)        !<-- Parent J south of child's west boundary point
              J_INDX_WBND(I_CHILD,J_CHILD,2)=INT(REAL_J_PARENT+EPS)+1      !<-- Parent J north of child's west boundary point
!
              WEIGHT_SW=(I_INDX_WBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (J_INDX_WBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_SE=(REAL_I_PARENT-I_INDX_WBND(I_CHILD,J_CHILD,1))* &
                        (J_INDX_WBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_NW=(I_INDX_WBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (REAL_J_PARENT-J_INDX_WBND(I_CHILD,J_CHILD,1))
              WEIGHT_NE=(REAL_I_PARENT-I_INDX_WBND(I_CHILD,J_CHILD,1))* &
                        (REAL_J_PARENT-J_INDX_WBND(I_CHILD,J_CHILD,1))
!
              RECIP_SUM=1./(WEIGHT_SW+WEIGHT_SE+WEIGHT_NW+WEIGHT_NE)
!
              WEIGHTS_WBND(I_CHILD,J_CHILD,INDX_SW)=WEIGHT_SW*RECIP_SUM    !<-- Interp wght of parent point SW of child bndry point
              WEIGHTS_WBND(I_CHILD,J_CHILD,INDX_SE)=WEIGHT_SE*RECIP_SUM    !<-- Interp wght of parent point SE of child bndry point
              WEIGHTS_WBND(I_CHILD,J_CHILD,INDX_NW)=WEIGHT_NW*RECIP_SUM    !<-- Interp wght of parent point NW of child bndry point
              WEIGHTS_WBND(I_CHILD,J_CHILD,INDX_NE)=WEIGHT_NE*RECIP_SUM    !<-- Interp wght of parent point NE of child bndry point
!
            ENDDO i_west
!
!-----------------------------------------------------------------------
          ENDIF child_ij_w
!-----------------------------------------------------------------------
!
!----------
!----------
!***  East
!----------
!----------
!
          REAL_I_START=PARENT_I_CHILD_EBND                                 !<-- I index of parent H for child's east H boundary
          KOUNT_I=0
!
          IF(FLAG_H_OR_V=='H_POINTS')THEN
            R_ITS=REAL(ITS)+EPS                                            !<-- REAL Istart of parent task's subdomain for H on B grid
            R_IEND=REAL(MIN(ITE+1,IDE))+EPS                                !<-- Allow search for child H boundary points to go into
                                                                           !    the parent's halo.
          ELSEIF(FLAG_H_OR_V=='V_POINTS')THEN
            R_ITS =REAL(ITS-0.5)+EPS                                       !<-- REAL Istart of parent task's subdomain for V on B grid
                                                                           !    (-0.5 yields same location on grid as R_JTS for H).
            R_IEND=REAL(MIN(REAL(ITE+0.5),REAL(IDE)))+EPS                  !<-- Use ITE+0.5 to stop V search at the row of the
                                                                           !    northernmost H that is searched; this ensures that
                                                                           !    a parent will send both H and V boundary points.
          ENDIF
!
!-----------------------------------------------------------------------
!***  Recall that we need an additional row of H points to allow 4-pt
!***  averaging of PD to V points.  We need only to search for the
!***  westernmost child J row of the east boundary blending region with
!***  the extra row because if that child I is on a parent task then
!***  all of the blending region must be on that task since we are 
!***  permitting the search to go into the parent tasks' haloes.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!      
          I_CHILD=IM_END
!      
!-----------------------------------------------------------------------
!
          child_ij_e: IF(REAL_I_START >=R_ITS.AND.REAL_I_START < R_IEND)THEN  !<-- Does parent task see this column of its child?
!
!-----------------------------------------------------------------------
!-------------------------------------------------------------
!***  Find the child tasks and their relevant limits
!***  along the child's eastern boundary.
!-------------------------------------------------------------
!
            DO NC=1,NUM_CHILD_TASKS                                        !<-- Loop through all tasks on child domain
!
              IF(J_CHILD>=J_LIMIT_LO(NC).AND.                           &  !<-- Does current child boundary point on this
                 J_CHILD<=J_LIMIT_HI(NC)                                &  !    parent task lie on child task "NC"?
                 .AND.                                                  &  !
                 I_CHILD>=ITS_CHILD(NC).AND.                            &  !
                 I_CHILD<=ITE_CHILD(NC))THEN
!
                IF(NC>NC_LAST_E)THEN                                       !<-- Have we encountered a new child task holding this E bndry?
                  NUM_TASKS_SEND_E=NUM_TASKS_SEND_E+1                      !<-- Then increment the E bndry counter of the child tasks
                  LOCAL_TASK_RANK_E(NUM_TASKS_SEND_E,1)=NC                 !<-- This child task's count in list of fcst tasks
                  LOCAL_TASK_RANK_E(NUM_TASKS_SEND_E,2)=CHILD_RANKS(NC-1)  !<-- This child task's local rank in p-c intracomm
                  NC_LAST_E=NC
                  NC_HOLD_E(NC)=NUM_TASKS_SEND_E
                ENDIF
!
                IF(J_SAVE_LO_EAST(NC_HOLD_E(NC))<0)THEN
                  J_SAVE_LO_EAST(NC_HOLD_E(NC))=J_CHILD                    !<-- Save southernmost Ebndry J of child task NC
                                                                           !    that is on this parent task.
                ENDIF
                J_SAVE_HI_EAST(NC_HOLD_E(NC))=J_CHILD                      !<-- Save northernmost Ebndry J of child task NC
                                                                           !    that is on this parent task.
!
              ENDIF
!
            ENDDO
!
!-----------------------------------------------------------------------
!
            i_east: DO I_CHILD=IM_END,IM_END-N_BLEND+1-N_ADD,-1            !<-- Blending region of child's eastern boundary
!
              KOUNT_I=KOUNT_I+1
              REAL_I_PARENT=REAL_I_START-(KOUNT_I-1)*RATIO_C_P             !<-- REAL parent I for this child's I
!
              I_INDX_EBND(I_CHILD,J_CHILD,1)=INT(REAL_I_PARENT+EPS)        !<-- Parent I west of child's east boundary point
              I_INDX_EBND(I_CHILD,J_CHILD,2)=INT(REAL_I_PARENT+EPS)+1      !<-- Parent I east of child's east boundary point
              J_INDX_EBND(I_CHILD,J_CHILD,1)=INT(REAL_J_PARENT+EPS)        !<-- Parent J south of child's east boundary point
              J_INDX_EBND(I_CHILD,J_CHILD,2)=INT(REAL_J_PARENT+EPS)+1      !<-- Parent J north of child's east boundary point
!
              WEIGHT_SW=(I_INDX_EBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (J_INDX_EBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_SE=(REAL_I_PARENT-I_INDX_EBND(I_CHILD,J_CHILD,1))* &
                        (J_INDX_EBND(I_CHILD,J_CHILD,2)-REAL_J_PARENT)
              WEIGHT_NW=(I_INDX_EBND(I_CHILD,J_CHILD,2)-REAL_I_PARENT)* &
                        (REAL_J_PARENT-J_INDX_EBND(I_CHILD,J_CHILD,1))
              WEIGHT_NE=(REAL_I_PARENT-I_INDX_EBND(I_CHILD,J_CHILD,1))* &
                        (REAL_J_PARENT-J_INDX_EBND(I_CHILD,J_CHILD,1))
!
              RECIP_SUM=1./(WEIGHT_SW+WEIGHT_SE+WEIGHT_NW+WEIGHT_NE)
!
              WEIGHTS_EBND(I_CHILD,J_CHILD,INDX_SW)=WEIGHT_SW*RECIP_SUM    !<-- Interp wght of parent point SW of child bndry point
              WEIGHTS_EBND(I_CHILD,J_CHILD,INDX_SE)=WEIGHT_SE*RECIP_SUM    !<-- Interp wght of parent point SE of child bndry point
              WEIGHTS_EBND(I_CHILD,J_CHILD,INDX_NW)=WEIGHT_NW*RECIP_SUM    !<-- Interp wght of parent point NW of child bndry point
              WEIGHTS_EBND(I_CHILD,J_CHILD,INDX_NE)=WEIGHT_NE*RECIP_SUM    !<-- Interp wght of parent point NE of child bndry point
!
            ENDDO i_east
!
!-----------------------------------------------------------------------
          ENDIF child_ij_e
!-----------------------------------------------------------------------
!
        ENDIF j_block
!
!-----------------------------------------------------------------------
!
      ENDDO j_loop
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_TO_CHILD_INTERP_FACTORS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE POINT_INTERP_DATA_TO_MEMORY(N_CHILD                    &
                                            ,MY_DOMAIN_ID               &
                                            ,TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  Create unallocated working pointers for nest boundary variables
!***  and point them into the allocated composite pointer that holds
!***  all of a parent task's data it will send to each child boundary
!***  task it covers.  Nest boundary pressure though must be allocated
!***  because it contains more data than is transferred since we need
!***  extra points in order to do the 4-pt averaging to the nest
!***  boundary V points for hydrostatic balancing of the boundary
!***  data.
!
!***  Only parents execute this routine.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &  !<-- This child is being handled.
                                      ,MY_DOMAIN_ID                        !<-- The parent domain's ID
!
      CHARACTER(*),INTENT(IN) :: TIME_FLAG                                 !<-- Current or future boundary data for the child?
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I_END_TRANSFER,ITE_CHILD_X,INDX2            &
                           ,J_END_TRANSFER,JTE_CHILD_X                  &
                           ,KOUNT_VAR,N,N_TASK                          &
                           ,NBASE,NBASE_3D,NBASE_4D,NBASE_EXP           &
                           ,NCHILD_TASKS                                &
                           ,NLOC_1,NLOC_2,NLOC_2_EXP                    &
                           ,NN,NT,NV,NVAR,NWORDS,PROD
!
      INTEGER(kind=KINT) :: ISTAT
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      N=N_CHILD
!
!-----------------------------------------------------------------------
!***  Select the appropriate part of the working array depending on
!***  whether we are now concerned with children's boundaries for
!***  their current time or for their future.
!-----------------------------------------------------------------------
!
      IF(TIME_FLAG=='Future')THEN
        INDX2=1
      ELSEIF(TIME_FLAG=='Current')THEN
        INDX2=2
      ENDIF
!
!-----------------------------------------------------------------------
!***  For each child domain on this parent, create the working pointers
!***  for the nest boundary variables for each child boundary task
!***  and point them into the allocated composite data pointer that
!***  holds all the data for transfer.  Nest boundary pressure is 
!***  treated differently by allocating it and eventually copying it
!***  directly into the composite data pointer.
!
!***  Set logical flags so parent tasks know if they must send any
!***  data at all to any nest boundary tasks.
!
!***  Allocate/nullify new MPI handles for the most recent association
!***  between parent tasks and nest boundary tasks for the ISends of
!***  data to the nest boundaries.
!-----------------------------------------------------------------------
!
!-----------
!***  South
!-----------
!
      south_h: IF(NUM_TASKS_SEND_H_S(N)>0)THEN                             !<-- Parent task has child south boundary H points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_H_S(N)                                 !<-- # of Sbndry tasks on child N to recv H point data
        ALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1:NCHILD_TASKS)     &  !<-- 1-D bndry data string for child tasks with Sbndry H points
                                                            ,stat=ISTAT)
        ALLOCATE(WORDS_BOUND_H_SOUTH(N)%TASKS(1:NCHILD_TASKS))             !<-- # of words in Sbndry H point 1-D data string
        ALLOCATE(PD_B_SOUTH(N)%TASKS(1:NCHILD_TASKS))                      !<-- PD_B_SOUTH for each child task
!
        DO NVAR=1,NVARS_NESTBC_H-1                                         !<-- All nest 3D BC H-pt variables (excludes PD)
          ALLOCATE(BND_VAR_H_SOUTH(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS) &  !<-- Working object for each 3D Sbnd H-pt vbl on each child task
                  ,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,11101)NVAR,N,NCHILD_TASKS,ISTAT
11101       FORMAT(' POINT_INTERP_DATA_TO_MEMORY failed to allocate'    &
                  ,' BND_VAR(',I2,')%CHILD(',I2,')%TASKS(1:',I4,')'     &
                  ,' ISTAT=',I4)
            CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT)
          ENDIF
        ENDDO
!
!-----------------------------------------------------------------------
!
        nt_south_h: DO NT=1,NCHILD_TASKS
!
          N_TASK=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NT,1)                    !<-- Count of this task in list of all child fcst tasks
!
          NBASE=CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(NT)             &
               -CHILDTASK_H_SAVE(N)%I_LO_SOUTH(NT)+1          
!
          PROD=NBASE*N_BLEND_H_CHILD(N)
          NBASE_3D=LM*PROD
          NWORDS=(NVARS_BC_2D_H+NVARS_BC_3D_H*LM)*PROD                     !<-- # of Sbndry words in 2D,3D H-pt vbls parent sends to child
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_H>1)THEN
            DO NV=2,NVARS_BC_2D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_H(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_H>0)THEN
            DO NV=1,NVARS_BC_3D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          IF(NVARS_BC_4D_H>0)THEN
            DO NV=1,NVARS_BC_4D_H
              NBASE_4D=(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 4-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_4D
              NWORDS=NWORDS+(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D           !<-- Add the # of Sbndry words in 4-D H-pt variables
            ENDDO
          ENDIF
!
          WORDS_BOUND_H_SOUTH(N)%TASKS(NT)=NWORDS                          !<-- Save total number of words
!
          CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA &
                        ,'CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA(1:NWORDS))  !<-- 1-D bndry data string for child tasks
!                                                                               with South boundary H points
          NLOC_1=1
          NLOC_2=NLOC_1+NBASE*N_BLEND_H_CHILD(N)-1
!
          NBASE_EXP=CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NT)                  &
                   -CHILDTASK_H_SAVE(N)%I_LO_SOUTH(NT)+1
!
          NLOC_2_EXP=NLOC_1+NBASE_EXP*(N_BLEND_H_CHILD(N)+1)-1             !<-- Extend PD_B_* to allow 4-pt averaging to V pts
!
          PD_B_SOUTH(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_SOUTH(N)%TASKS(NT)%DATA                  &
                        ,'PD_B_SOUTH(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_SOUTH(N)%TASKS(NT)%DATA(NLOC_1:NLOC_2_EXP),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest H-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's south side.
!-----------------------------------------------------------------------
!
          DO NVAR=1,NVARS_NESTBC_H-1
!
            NLOC_1=NLOC_2+1                                                !<-- Start at NLOC_2, NOT NLOC_2_EXPAND
            NLOC_2=NLOC_1+NBASE_VAR_H(NVAR)-1
            BND_VAR_H_SOUTH(NVAR)%CHILD(N)%TASKS(NT)%DATA=>             &
              CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)   !<-- Sbndry storage for H-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO  nt_south_h
!
      ELSE  south_h                                                        !<-- Dummy nonzero length 
!
        ALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1)%DATA       &
                      ,'CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_SOUTH(N)%TASKS(1:1))              
        PD_B_SOUTH(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_SOUTH(N)%TASKS(1)%DATA                      &
                      ,'PD_B_SOUTH(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_SOUTH(N)%TASKS(1)%DATA(1:1),stat=ISTAT)              
!
        DO NVAR=1,NVARS_NESTBC_H-1
          ALLOCATE(BND_VAR_H_SOUTH(NVAR)%CHILD(N)%TASKS(1:1),stat=ISTAT)
          IF(ISTAT>0)THEN
            WRITE(0,11201)NVAR,N,ISTAT
11201       FORMAT(' POINT_INTERP_DATA_TO_MEMORY failed to allocate'    &
                  ,' dummy BND_VAR(',I2,')%CHILD(',I2,')%TASKS(1:1)'    &
                  ,' ISTAT=',I4)
          ENDIF
          BND_VAR_H_SOUTH(NVAR)%CHILD(N)%TASKS(1)%DATA=>NULL()
        ENDDO
!
        ALLOCATE(WORDS_BOUND_H_SOUTH(N)%TASKS(1:1))           
!
      ENDIF south_h
!
!-----------------------------------------------------------------------
!
      south_v: IF(NUM_TASKS_SEND_V_S(N)>0)THEN                             !<-- Parent task has child south boundary V points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_V_S(N)
        ALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1:NCHILD_TASKS))       !<-- 1-D bndry data string for child tasks with Sbndry V points
        ALLOCATE(WORDS_BOUND_V_SOUTH(N)%TASKS(1:NCHILD_TASKS))             !<-- # of words in Sbndry V point 1-D data string
!
        ALLOCATE(PD_B_SOUTH_V(N)%TASKS(1:NCHILD_TASKS))                    !<-- PD_B_SOUTH_V for each child task
!
        DO NVAR=1,NVARS_NESTBC_V                                           !<-- All nest 3D BC V-pt variables
          ALLOCATE(BND_VAR_V_SOUTH(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))   !<-- Working object for each 3D Sbnd V-pt vbl on each child task
        ENDDO
!
        DO NT=1,NCHILD_TASKS
          NBASE   =CHILDTASK_V_SAVE(N)%I_HI_SOUTH(NT)                   &
                  -CHILDTASK_V_SAVE(N)%I_LO_SOUTH(NT)+1
          PROD=NBASE*N_BLEND_V_CHILD(N)
          NBASE_3D=LM*PROD
          NWORDS=(NVARS_BC_2D_V+NVARS_BC_3D_V*LM)*PROD                     !<-- # of Sbndry words in 2D,3D V-pt vbls parent sends to child
          WORDS_BOUND_V_SOUTH(N)%TASKS(NT)=NWORDS                          !<-- Save total number of words
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_V>0)THEN
            DO NV=2,NVARS_BC_2D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_V(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_V>0)THEN
            DO NV=1,NVARS_BC_3D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_V(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA   &
                        ,'CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA(1:NWORDS))  !<-- 1-D bndry data string for child tasks with Sbndry V points
!
          PD_B_SOUTH_V(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_SOUTH_V(N)%TASKS(NT)%DATA                &
                        ,'PD_B_SOUTH_V(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_SOUTH_V(N)%TASKS(NT)%DATA(1:NBASE*N_BLEND_V_CHILD(N)),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest V-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's south side.
!-----------------------------------------------------------------------
!
          NLOC_2=0
          DO NVAR=1,NVARS_NESTBC_V
!
            NLOC_1=NLOC_2+1
            NLOC_2=NLOC_1+NBASE_VAR_V(NVAR)-1
            BND_VAR_V_SOUTH(NVAR)%CHILD(N)%TASKS(NT)%DATA=>             &
              CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)   !<-- S bndry storage for V-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO
!
      ELSE  south_v                                                        !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1)%DATA      &
                      ,'CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_SOUTH_V(N)%TASKS(1:1))
        PD_B_SOUTH_V(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_SOUTH_V(N)%TASKS(1)%DATA                   &
                      ,'PD_B_SOUTH_V(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_SOUTH_V(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_V
          ALLOCATE(BND_VAR_V_SOUTH(NVAR)%CHILD(N)%TASKS(1:1))             
          BND_VAR_V_SOUTH(NVAR)%CHILD(N)%TASKS(1)%DATA=>NULL()
        ENDDO
!
        ALLOCATE(WORDS_BOUND_V_SOUTH(N)%TASKS(1:1))           
!
      ENDIF south_v
!
!------------------------------------------------------------------------
!
!-----------
!***  North
!-----------
!
      north_h: IF(NUM_TASKS_SEND_H_N(N)>0)THEN                              !<-- Parent task has child north boundary H points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_H_N(N)
        ALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1:NCHILD_TASKS)      &  !<-- 1-D bndry data string for child tasks with Nbndry H points
                                                            ,stat=ISTAT)
        ALLOCATE(WORDS_BOUND_H_NORTH(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Nbndry H point 1-D data string
        ALLOCATE(PD_B_NORTH(N)%TASKS(1:NCHILD_TASKS))                       !<-- PD_B_NORTH for each child task
!
        DO NVAR=1,NVARS_NESTBC_H-1                                          !<-- All nest 3D BC H-pt variables (excludes PD)
          ALLOCATE(BND_VAR_H_NORTH(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))    !<-- Working object for each 3D Nbnd H-pt vbl on each child task
        ENDDO
!
        nt_north_h: DO NT=1,NCHILD_TASKS
!
          N_TASK=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NT,1)                     !<-- Count of this task in list of all child fcst tasks
!
!------------------------------------------------------------------------
!
          NBASE=CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(NT)              &
               -CHILDTASK_H_SAVE(N)%I_LO_NORTH(NT)+1
!
          PROD=NBASE*N_BLEND_H_CHILD(N)
          NBASE_3D=LM*NBASE*N_BLEND_H_CHILD(N)
          NWORDS=(NVARS_BC_2D_H+NVARS_BC_3D_H*LM)*PROD                      !<-- # of Nbndry words in 2D,3D H-pt vbls parent sends to child
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_H>1)THEN
            DO NV=2,NVARS_BC_2D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_H(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_H>0)THEN
            DO NV=1,NVARS_BC_3D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          IF(NVARS_BC_4D_H>0)THEN
            DO NV=1,NVARS_BC_4D_H
              NBASE_4D=(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 4-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_4D
              NWORDS=NWORDS+(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D           !<-- Add the # of Nbndry words in 4-D H-pt variables
            ENDDO
          ENDIF
!
          WORDS_BOUND_H_NORTH(N)%TASKS(NT)=NWORDS                           !<-- Save total number of words

          CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA(1:NWORDS) &  !<-- 1-D bndry data string for child tasks
                                                             ,stat=ISTAT)   !     with north boundary H points.
          NLOC_1=1
          NLOC_2=NLOC_1+NBASE*N_BLEND_H_CHILD(N)-1
!
          NBASE_EXP=CHILDTASK_H_SAVE(N)%I_HI_NORTH(NT)                   &
                   -CHILDTASK_H_SAVE(N)%I_LO_NORTH(NT)+1
!
          NLOC_2_EXP=NLOC_1+NBASE_EXP*(N_BLEND_H_CHILD(N)+1)-1              !<-- Extend PD_B_* by one row to allow 4-pt averaging to V pts
!
          PD_B_NORTH(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_NORTH(N)%TASKS(NT)%DATA                   &
                        ,'PD_B_NORTH(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_NORTH(N)%TASKS(NT)%DATA(NLOC_1:NLOC_2_EXP)       &
                                                           ,stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest H-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's north side.
!-----------------------------------------------------------------------
!
          DO NVAR=1,NVARS_NESTBC_H-1
!
            NLOC_1=NLOC_2+1                                                !<-- Start at NLOC_2, NOT NLOC_2_EXPAND
            NLOC_2=NLOC_1+NBASE_VAR_H(NVAR)-1
            BND_VAR_H_NORTH(NVAR)%CHILD(N)%TASKS(NT)%DATA=>             &
              CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)   !<-- N bndry storage for H-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO  nt_north_h
!
      ELSE  north_h                                                         !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1)%DATA       &
                      ,'CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(1)%DATA(1:1)         &
                                                           ,stat=ISTAT)
        ALLOCATE(PD_B_NORTH(N)%TASKS(1:1))
        PD_B_NORTH(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_NORTH(N)%TASKS(1)%DATA                      &
                      ,'PD_B_NORTH(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_NORTH(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_H-1
          ALLOCATE(BND_VAR_H_NORTH(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_H_NORTH(N)%TASKS(1:1))           
!
      ENDIF north_h
!
!------------------------------------------------------------------------
!
      north_v: IF(NUM_TASKS_SEND_V_N(N)>0)THEN                              !<-- Parent task has child north boundary V points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_V_N(N)
        ALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1:NCHILD_TASKS))        !<-- 1-D bndry data string for child tasks with Nbndry V points
        ALLOCATE(WORDS_BOUND_V_NORTH(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Nbndry V point 1-D data string
!
        ALLOCATE(PD_B_NORTH_V(N)%TASKS(1:NCHILD_TASKS))                     !<-- PD_B_NORTH_V for each child task
!
        DO NVAR=1,NVARS_NESTBC_V                                           !<-- All nest 3D BC V-pt variables
          ALLOCATE(BND_VAR_V_NORTH(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))   !<-- Working object for each 3D Nbnd V-pt vbl on each child task
        ENDDO
!
        DO NT=1,NCHILD_TASKS
          NBASE=CHILDTASK_V_SAVE(N)%I_HI_NORTH(NT)                       &
               -CHILDTASK_V_SAVE(N)%I_LO_NORTH(NT)+1
          PROD=NBASE*N_BLEND_V_CHILD(N)
          NBASE_3D=LM*PROD             
          NWORDS=(NVARS_BC_2D_V+NVARS_BC_3D_V*LM)*PROD                      !<-- # of Nbndry words in 2D,3D V-pt vbls parent sends to child
          WORDS_BOUND_V_NORTH(N)%TASKS(NT)=NWORDS                           !<-- Save total number of words
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_V>0)THEN
            DO NV=2,NVARS_BC_2D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_V(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_V>0)THEN
            DO NV=1,NVARS_BC_3D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_V(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA(1:NWORDS) &  !<-- 1-D bndry data string for child tasks with Nbndry V points
                                                             ,stat=ISTAT)   
!
          PD_B_NORTH_V(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_NORTH_V(N)%TASKS(NT)%DATA                 &
                        ,'PD_B_NORTH_V(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_NORTH_V(N)%TASKS(NT)%DATA(1:NBASE*N_BLEND_V_CHILD(N)) &
                                                                 ,stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest V-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's north side.
!-----------------------------------------------------------------------
!
          NLOC_2=0
          DO NVAR=1,NVARS_NESTBC_V
!
            NLOC_1=NLOC_2+1
            NLOC_2=NLOC_1+NBASE_VAR_V(NVAR)-1
            BND_VAR_V_NORTH(NVAR)%CHILD(N)%TASKS(NT)%DATA=>             &
              CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)   !<-- N bndry storage for V-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO
!
      ELSE  north_v                                                         !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1)%DATA       &
                      ,'CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(1)%DATA(1:1)         &
                                                           ,stat=ISTAT)
        ALLOCATE(PD_B_NORTH_V(N)%TASKS(1:1))
        PD_B_NORTH_V(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_NORTH_V(N)%TASKS(1)%DATA                    &
                      ,'PD_B_NORTH_V(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_NORTH_V(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_V
          ALLOCATE(BND_VAR_V_NORTH(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_V_NORTH(N)%TASKS(1:1))           
!
      ENDIF north_v
!
!------------------------------------------------------------------------
!
!----------
!***  West
!----------
!
      west_h: IF(NUM_TASKS_SEND_H_W(N)>0)THEN                              !<-- Parent task has child west boundary H points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_H_W(N)
        ALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1:NCHILD_TASKS)      &  !<-- 1-D bndry data string for child tasks with Wbndry H points
                                                            ,stat=ISTAT)
        ALLOCATE(WORDS_BOUND_H_WEST(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Wbndry H point 1-D data string
        ALLOCATE(PD_B_WEST(N)%TASKS(1:NCHILD_TASKS))                       !<-- PD_B_WEST for each child task
!
        DO NVAR=1,NVARS_NESTBC_H-1                                         !<-- All nest 3D BC H-pt variables (excludes PD)
          ALLOCATE(BND_VAR_H_WEST(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))    !<-- Working object for each 3D Wbnd H-pt vbl on each child task
        ENDDO
!
        nt_west_h: DO NT=1,NCHILD_TASKS
!
          N_TASK=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NT,1)                     !<-- Count of this task in list of all child fcst tasks
!
!-----------------------------------------------------------------------
!
          NBASE=CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER(NT)              &
               -CHILDTASK_H_SAVE(N)%J_LO_WEST(NT)+1
!
          PROD=NBASE*N_BLEND_H_CHILD(N)
          NBASE_3D=LM*PROD                     
          NWORDS=(NVARS_BC_2D_H+NVARS_BC_3D_H*LM)*PROD                     !<-- # of Wbndry words in 2D,3D H-pt vbls parent sends to child
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_H>1)THEN
            DO NV=2,NVARS_BC_2D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_H(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_H>0)THEN
            DO NV=1,NVARS_BC_3D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          IF(NVARS_BC_4D_H>0)THEN
            DO NV=1,NVARS_BC_4D_H
              NBASE_4D=(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 4-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_4D
              NWORDS=NWORDS+(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D           !<-- Add the # of Wbndry words in 4-D H-pt variables
            ENDDO
          ENDIF
!
          WORDS_BOUND_H_WEST(N)%TASKS(NT)=NWORDS                           !<-- Save total number of words
!
          CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA(1:NWORDS))   !<-- 1-D bndry data string for child tasks
!                                                                               with west boundary H points
          NLOC_1=1
          NLOC_2=NLOC_1+NBASE*N_BLEND_H_CHILD(N)-1
!
          NBASE_EXP=CHILDTASK_H_SAVE(N)%J_HI_WEST(NT)                   &
                   -CHILDTASK_H_SAVE(N)%J_LO_WEST(NT)+1
!
          NLOC_2_EXP=NLOC_1+NBASE_EXP*(N_BLEND_H_CHILD(N)+1)-1             !<-- Extend PD_B_* by one row to allow 4-pt averaging to V pts
!
          PD_B_WEST(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_WEST(N)%TASKS(NT)%DATA                    &
                        ,'PD_B_WEST(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_WEST(N)%TASKS(NT)%DATA(NLOC_1:NLOC_2_EXP),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest H-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's west side.
!-----------------------------------------------------------------------
!
          DO NVAR=1,NVARS_NESTBC_H-1
!
            NLOC_1=NLOC_2+1                                                !<-- Start at NLOC_2, NOT NLOC_2_EXPAND
            NLOC_2=NLOC_1+NBASE_VAR_H(NVAR)-1
            BND_VAR_H_WEST(NVAR)%CHILD(N)%TASKS(NT)%DATA=>              &
              CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)    !<-- W bndry storage for H-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO  nt_west_h
!
      ELSE  west_h                                                          !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1)%DATA        &
                      ,'CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_WEST(N)%TASKS(1:1))
        PD_B_WEST(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_WEST(N)%TASKS(1)%DATA                       &
                      ,'PD_B_WEST(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_WEST(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_H-1
          ALLOCATE(BND_VAR_H_WEST(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_H_WEST(N)%TASKS(1:1))           
!
      ENDIF west_h
!
!-----------------------------------------------------------------------
!
      west_v: IF(NUM_TASKS_SEND_V_W(N)>0)THEN                              !<-- Parent task has child west boundary V points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_V_W(N)
        ALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1:NCHILD_TASKS))        !<-- 1-D bndry data string for child tasks with Wbndry V points
        ALLOCATE(WORDS_BOUND_V_WEST(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Wbndry V point 1-D data string
!
        ALLOCATE(PD_B_WEST_V(N)%TASKS(1:NCHILD_TASKS))                     !<-- PD_B_WEST_V for each child task
!
        DO NVAR=1,NVARS_NESTBC_V                                           !<-- All nest 3D BC V-pt variables
          ALLOCATE(BND_VAR_V_WEST(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS)  &  !<-- Working object for each 3D Wbnd V-pt vbl on each child task
                  ,stat=ISTAT)
        ENDDO
!
        DO NT=1,NCHILD_TASKS
          NBASE=CHILDTASK_V_SAVE(N)%J_HI_WEST(NT)                       &  
               -CHILDTASK_V_SAVE(N)%J_LO_WEST(NT)+1
          PROD=NBASE*N_BLEND_V_CHILD(N)
          NBASE_3D=LM*PROD               
          NWORDS=(NVARS_BC_2D_V+NVARS_BC_3D_V*LM)*PROD                      !<-- # of Wbndry words in 2D,3D V-pt vbls parent sends to child
          WORDS_BOUND_V_WEST(N)%TASKS(NT)=NWORDS                            !<-- Save total number of words
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_V>0)THEN
            DO NV=2,NVARS_BC_2D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_V(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_V>0)THEN
            DO NV=1,NVARS_BC_3D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_V(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA(1:NWORDS) &   !<-- 1-D bndry data string for child tasks with Wbndry V points
                  ,stat=ISTAT)
!
          PD_B_WEST_V(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_WEST_V(N)%TASKS(NT)%DATA                 &
                        ,'PD_B_WEST_V(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_WEST_V(N)%TASKS(NT)%DATA(1:NBASE*N_BLEND_V_CHILD(N)),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest V-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's west side.
!-----------------------------------------------------------------------
!
          NLOC_2=0
          DO NVAR=1,NVARS_NESTBC_V
!
            NLOC_1=NLOC_2+1
            NLOC_2=NLOC_1+NBASE_VAR_V(NVAR)-1
            BND_VAR_V_WEST(NVAR)%CHILD(N)%TASKS(NT)%DATA=>              &
              CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)    !<-- W bndry storage for V-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO
!
      ELSE  west_v                                                          !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1)%DATA        &
                      ,'CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_WEST_V(N)%TASKS(1:1))
        PD_B_WEST_V(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_WEST_V(N)%TASKS(1)%DATA                     &
                      ,'PD_B_WEST_V(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_WEST_V(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_V
          ALLOCATE(BND_VAR_V_WEST(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_V_WEST(N)%TASKS(1:1))           
!
      ENDIF west_v
!
!-----------------------------------------------------------------------
!
!----------
!***  East
!----------
!
      east_h: IF(NUM_TASKS_SEND_H_E(N)>0)THEN                              !<-- Parent task has child east boundary H points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_H_E(N)
        ALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1:NCHILD_TASKS)      &  !<-- 1-D bndry data string for child tasks with Ebndry H points
                                                            ,stat=ISTAT)
        ALLOCATE(WORDS_BOUND_H_EAST(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Ebndry H point 1-D data string
!
        ALLOCATE(PD_B_EAST(N)%TASKS(1:NCHILD_TASKS))                       !<-- PD_B_EAST for each child task
!
        DO NVAR=1,NVARS_NESTBC_H-1                                         !<-- All nest 3D BC H-pt variables (excludes PD)
          ALLOCATE(BND_VAR_H_EAST(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))    !<-- Working object for each 3D Ebnd H-pt vbl on each child task
        ENDDO
!
        nt_east_h: DO NT=1,NCHILD_TASKS
!
          N_TASK=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NT,1)                     !<-- Count of this task in list of all child fcst tasks
!
!-----------------------------------------------------------------------
!
          NBASE=CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER(NT)              &
               -CHILDTASK_H_SAVE(N)%J_LO_EAST(NT)+1
!
          PROD=NBASE*N_BLEND_H_CHILD(N)
          NBASE_3D=LM*NBASE*N_BLEND_H_CHILD(N)
          NWORDS=(NVARS_BC_2D_H+NVARS_BC_3D_H*LM)*PROD                     !<-- # of Ebndry words in 2D,3D H-pt vbls parent sends to child
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_H>1)THEN
            DO NV=2,NVARS_BC_2D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_H(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_H>0)THEN
            DO NV=1,NVARS_BC_3D_H
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          IF(NVARS_BC_4D_H>0)THEN
            DO NV=1,NVARS_BC_4D_H
              NBASE_4D=(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 4-D H-pt vbls
              NBASE_VAR_H(KOUNT_VAR)=NBASE_4D
              NWORDS=NWORDS+(UBND_4D(NV)-LBND_4D(NV)+1)*NBASE_3D           !<-- Add the # of Wbndry words in 4-D H-pt variables
            ENDDO
          ENDIF
!
          WORDS_BOUND_H_EAST(N)%TASKS(NT)=NWORDS                           !<-- Save total number of words
!
          CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA(1:NWORDS))   !<-- 1-D bndry data string for child tasks
!                                                                               with east boundary H points
          NLOC_1=1
          NLOC_2=NLOC_1+NBASE*N_BLEND_H_CHILD(N)-1
!
          NBASE_EXP=CHILDTASK_H_SAVE(N)%J_HI_EAST(NT)                   &
                   -CHILDTASK_H_SAVE(N)%J_LO_EAST(NT)+1
!
          NLOC_2_EXP=NLOC_1+NBASE_EXP*(N_BLEND_H_CHILD(N)+1)-1             !<-- Extend PD_B_* by one row to allow 4-pt averaging to V pts
!
          PD_B_EAST(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_EAST(N)%TASKS(NT)%DATA                   &
                        ,'PD_B_EAST(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_EAST(N)%TASKS(NT)%DATA(NLOC_1:NLOC_2_EXP),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest H-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's east side.
!-----------------------------------------------------------------------
!
          DO NVAR=1,NVARS_NESTBC_H-1
!
            NLOC_1=NLOC_2+1                                               !<-- Start at NLOC_2, NOT NLOC_2_EXPAND
            NLOC_2=NLOC_1+NBASE_VAR_H(NVAR)-1
            BND_VAR_H_EAST(NVAR)%CHILD(N)%TASKS(NT)%DATA=>             &
               CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)  !<-- E bndry storage for H-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO  nt_east_h
!
      ELSE east_h                                                           !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1)%DATA        &
                      ,'CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_EAST(N)%TASKS(1:1))
        PD_B_EAST(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_EAST(N)%TASKS(1)%DATA                       &
                      ,'PD_B_EAST(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_EAST(N)%TASKS(1)%DATA(1:1))
!
        DO NVAR=1,NVARS_NESTBC_H-1
          ALLOCATE(BND_VAR_H_EAST(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_H_EAST(N)%TASKS(1:1))           
!
      ENDIF east_h
!
!-----------------------------------------------------------------------
!
      east_v: IF(NUM_TASKS_SEND_V_E(N)>0)THEN                              !<-- Parent task has child east boundary V points?
!
        NCHILD_TASKS=NUM_TASKS_SEND_V_E(N)
        ALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1:NCHILD_TASKS))        !<-- 1-D bndry data string for child tasks with Ebndry V points
        ALLOCATE(WORDS_BOUND_V_EAST(N)%TASKS(1:NCHILD_TASKS))              !<-- # of words in Ebndry V point 1-D data string
!
        ALLOCATE(PD_B_EAST_V(N)%TASKS(1:NCHILD_TASKS))                     !<-- PD_B_EAST_V for each child task
!
        DO NVAR=1,NVARS_NESTBC_V                                           !<-- All nest 3D BC V-pt variables
          ALLOCATE(BND_VAR_V_EAST(NVAR)%CHILD(N)%TASKS(1:NCHILD_TASKS))    !<-- Working object for each 3D Ebnd V-pt vbl on each child task
        ENDDO
!
        DO NT=1,NCHILD_TASKS
          NBASE=CHILDTASK_V_SAVE(N)%J_HI_EAST(NT)                       &
               -CHILDTASK_V_SAVE(N)%J_LO_EAST(NT)+1
          PROD=NBASE*N_BLEND_V_CHILD(N)
          NBASE_3D=LM*PROD                 
          NWORDS=(NVARS_BC_2D_V+NVARS_BC_3D_V*LM)*PROD                     !<-- # of Ebndry words in 2D,3D V-pt vbls parent sends to child
          WORDS_BOUND_V_EAST(N)%TASKS(NT)=NWORDS                           !<-- Save total number of words
!
          KOUNT_VAR=0
          IF(NVARS_BC_2D_V>0)THEN
            DO NV=2,NVARS_BC_2D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Count 2-D H-pt vbls excluding PD
              NBASE_VAR_V(KOUNT_VAR)=NBASE
            ENDDO
          ENDIF
!
          IF(NVARS_BC_3D_V>0)THEN
            DO NV=1,NVARS_BC_3D_V
              KOUNT_VAR=KOUNT_VAR+1                                        !<-- Add the 3-D H-pt vbls
              NBASE_VAR_V(KOUNT_VAR)=NBASE_3D
            ENDDO
          ENDIF
!
          CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA    &
                        ,'CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA')
          ALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA(1:NWORDS))   !<-- 1-D bndry data string for child tasks with Ebndry V points
!
          PD_B_EAST_V(N)%TASKS(NT)%DATA=>NULL()
          CALL CHECK_REAL(PD_B_EAST_V(N)%TASKS(NT)%DATA                 &
                        ,'PD_B_EAST_V(N)%TASKS(NT)%DATA')
          ALLOCATE(PD_B_EAST_V(N)%TASKS(NT)%DATA(1:NBASE*N_BLEND_V_CHILD(N)),stat=ISTAT)
!
!-----------------------------------------------------------------------
!***  Point the working pointer for each nest V-pt boundary variable
!***  into the object that holds all nest BC update data for child N's
!***  domain's east side.
!-----------------------------------------------------------------------
!
          NLOC_2=0
          DO NVAR=1,NVARS_NESTBC_V
!
            NLOC_1=NLOC_2+1
            NLOC_2=NLOC_1+NBASE_VAR_V(NVAR)-1
            BND_VAR_V_EAST(NVAR)%CHILD(N)%TASKS(NT)%DATA=>              &
               CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA(NLOC_1:NLOC_2)   !<-- E bndry storage for V-pt vbl NVAR, child N, task NT
!
          ENDDO
!
        ENDDO
!
      ELSE  east_v                                                         !<-- Dummy nonzero length
!
        ALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1:1))       
        CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1)%DATA       &
                      ,'CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1)%DATA')
        ALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(1)%DATA(1:1))
        ALLOCATE(PD_B_EAST_V(N)%TASKS(1:1))
        PD_B_EAST_V(N)%TASKS(1)%DATA=>NULL()
        CALL CHECK_REAL(PD_B_EAST_V(N)%TASKS(1)%DATA                    &
                      ,'PD_B_EAST_V(N)%TASKS(1)%DATA')
        ALLOCATE(PD_B_EAST_V(N)%TASKS(1)%DATA(1:1),stat=ISTAT)
!
        DO NVAR=1,NVARS_NESTBC_V
          ALLOCATE(BND_VAR_V_EAST(NVAR)%CHILD(N)%TASKS(1:1))
        ENDDO
!
        ALLOCATE(WORDS_BOUND_V_EAST(N)%TASKS(1:1))           
!
      ENDIF east_v
!
!-----------------------------------------------------------------------
!***  Here we set logical flags so each parent tasks knows whether or
!***  not it must send data to any side of child N's boundary.
!-----------------------------------------------------------------------
!
      IF(NUM_TASKS_SEND_H_S(N)>0.OR.                                    &
         NUM_TASKS_SEND_H_N(N)>0.OR.                                    &
         NUM_TASKS_SEND_H_W(N)>0.OR.                                    &
         NUM_TASKS_SEND_H_E(N)>0.OR.                                    &
         NUM_TASKS_SEND_V_S(N)>0.OR.                                    &
         NUM_TASKS_SEND_V_N(N)>0.OR.                                    &
         NUM_TASKS_SEND_V_W(N)>0.OR.                                    &
         NUM_TASKS_SEND_V_E(N)>0)THEN
!
        SEND_CHILD_DATA(N)=.TRUE.
!
      ELSE
        SEND_CHILD_DATA(N)=.FALSE.
      ENDIF
!
!-----------------------------------------------------------------------
!***  Allocate and initialize the new handles created for ISends 
!***  between parent tasks and nest boundary tasks.  That association
!***  of tasks obviously changes each time the nests move.
!-----------------------------------------------------------------------
!
!-------------------------------
!***  For child boundary, south
!-------------------------------
!
      IF(NUM_TASKS_SEND_H_S(N)>0)THEN
        ALLOCATE(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_H_S(N)) &
                ,stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:',NUM_TASKS_SEND_H_S(N) &
                   ,')  stat=',ISTAT
          WRITE(0,*)' N=',N,' INDX2=',INDX2
!       ELSE
!         WRITE(0,*)' Allocated HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:',NUM_TASKS_SEND_H_S(N),')'
        ENDIF
        DO NN=1,NUM_TASKS_SEND_H_S(N)
          HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:1),stat=ISTAT)
        IF(ISTAT/=0)THEN
          WRITE(0,*)' Failed to allocate dummy HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:1)  stat=',ISTAT
          WRITE(0,*)' N=',N,' INDX2=',INDX2
!       ELSE 
!         WRITE(0,*)' Allocated dummy HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:1)'
        ENDIF
        HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
      IF(NUM_TASKS_SEND_V_S(N)>0)THEN
        ALLOCATE(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_V_S(N)))
        DO NN=1,NUM_TASKS_SEND_V_S(N)
          HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
!-------------------------------
!***  For child boundary, north
!-------------------------------
!
      IF(NUM_TASKS_SEND_H_N(N)>0)THEN
        ALLOCATE(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_H_N(N)))
        DO NN=1,NUM_TASKS_SEND_H_N(N)
          HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
      IF(NUM_TASKS_SEND_V_N(N)>0)THEN
        ALLOCATE(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_V_N(N)))
        DO NN=1,NUM_TASKS_SEND_V_N(N)
          HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
!------------------------------
!***  For child boundary, west
!------------------------------
!
      IF(NUM_TASKS_SEND_H_W(N)>0)THEN
        ALLOCATE(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_H_W(N)))
        DO NN=1,NUM_TASKS_SEND_H_W(N)
          HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
      IF(NUM_TASKS_SEND_V_W(N)>0)THEN
        ALLOCATE(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_V_W(N)))
        DO NN=1,NUM_TASKS_SEND_V_W(N)
          HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
!------------------------------
!***  For child boundary, east
!------------------------------
!
      IF(NUM_TASKS_SEND_H_E(N)>0)THEN
        ALLOCATE(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_H_E(N)))
        DO NN=1,NUM_TASKS_SEND_H_E(N)
          HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
      IF(NUM_TASKS_SEND_V_E(N)>0)THEN
        ALLOCATE(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(1:NUM_TASKS_SEND_V_E(N)))
        DO NN=1,NUM_TASKS_SEND_V_E(N)
          HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(NN)=MPI_REQUEST_NULL
        ENDDO
      ELSE
        ALLOCATE(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(1:1))
        HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(1)=MPI_REQUEST_NULL
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE POINT_INTERP_DATA_TO_MEMORY
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_SENDS_CHILD_DATA_LIMITS(N_CHILD                 &
                                               ,MY_DOMAIN_ID            &
                                               ,TIME_FLAG )
!
!-----------------------------------------------------------------------
!***  Parents send children basic bookkeeping information needed
!***  for the exchange of boundary data during the integration.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &   !<-- The child being considered by this parent
                                      ,MY_DOMAIN_ID                         !<-- Parent's domain ID
!
      CHARACTER(len=*),INTENT(IN) :: TIME_FLAG                              !<-- For future or current BC data from parent
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ID,ID_ADD,ID_CHILD,ID_CHILDTASK,IERR,ISTAT  &
                           ,MYPE,N,NRANK,NT,NTAG_SEND,NTX
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_PACKET,INFO
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      TYPE(COMPOSITE),POINTER :: CC
!
      integer(kind=kint) :: lb1,ub1,nz
      integer(kind=kint),dimension(8) :: values
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Parent tasks send six pieces of information (five for V points) 
!***  to child tasks on child domain boundaries so those child tasks
!***  will be able to receive boundary data and use it properly.  The
!***  final two are used to serve as checks that the intended child
!***  targeted tasks are the actual recipients.
!
!     (1) The parent-child intracomm rank of the sending parent task.
!     (2) The child boundary tasks' starting (I,J) on the parent task.
!     (3) The child boundary tasks' ending (I,J) on the parent task.
!
!     (4) The child boundary tasks' ending (I,J) on the parent task <--  Only for H points.
!         for the extended data to allow for 4-pt interpolation.    <--
!
!     (5) The parent-child intracomm rank of the target child task.
!     (6) The domain ID of the target child task.
!
!***  The child task must be able to know if the data it receives
!***  pertains to south boundary H or V points, north boundary
!***  H or V, points, etc.  Thus the MPI tag will indicate
!***  the boundary's side and variable type.
!
!      11111 --> South H
!      22222 --> South V
!      33333 --> North H
!      44444 --> North V
!      55555 --> West H  
!      66666 --> West V
!      77777 --> East H  
!      88888 --> East V
!
!*** (The child tasks know which side of their domain's boundary they
!***  are on of course but since a corner task is on more than one side,
!***  the above tags indicating the side are used for all child tasks.)
!-----------------------------------------------------------------------
!
      N=N_CHILD
      ID=MY_DOMAIN_ID
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!
      CALL MPI_COMM_RANK(COMM_TO_MY_CHILDREN(N),MYPE,IERR)                 !<-- Obtain rank of parent task
      ID_CHILD=MY_CHILDREN_ID(N)
      ID_ADD=1000*ID_CHILD
!
!-------------
!***  South H
!-------------
!
      HANDLE_PACKET=>HANDLE_PACKET_S_H(ID)%CHILDREN(N)%DATA
!
      sh_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:6,NT,1)                     !<-- South H info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_H_S(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_H_S(N)                                   !<-- Look for a child task with south boundary H points
            ID_CHILDTASK=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NTX,1)           !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ south boundary H points
              NRANK=ID_CHILDTASK-1                             
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=11111+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_H_SAVE(N)%I_LO_SOUTH(NTX)                  !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_H_SAVE(N)%I_HI_SOUTH_TRANSFER(NTX)         !<-- Save the ending index of boundary segment on child
              INFO(4)=CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NTX)                  !<-- Save the ending index of expanded boundary segment on child
              INFO(5)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(6)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
!     write(0,56561)my_domain_id,n,id_child,nt,nrank,id_childtask
!     write(0,56562)ntag_send,id_childtask,id_add,info
56561 format(' PARENT_SENDS_CHILD_DATA_LIMITS my_domain_id=',i2,' to send SH to child #',i2,' domain id=',i2,' task #',i3 &
            ,' nrank=',i3,' child task rank=',i3)
56562 format(' tag=',i6,' intracomm rank=',i3,' id_add=',i5,' info=',6(1x,i5))
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Sbndry task
                             ,6                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!     write(0,56563)id_childtask
56563 format(' sent SH info to id_childtask=',i3)
!     write(0,*)' S_H parent ISent child #',n,' child domain id=',id_child,' task #',nt,' nrank=',nrank,' ntx=',ntx &
!               ,' child task count=',CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NTX,1) &
!              ,' intracomm rank=',id_childtask,' ierr=',ierr
!     write(0,*)' south_h info=',info
! 
              CYCLE sh_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no south boundary H points
        NTAG_SEND=11111+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!     write(0,*)' PARENT_SENDS_CHILD_DATA_LIMITS my_domain_id=',id,' dummy South H isend to child #',n,' child rank ',ID_CHILDTASK &
!              ,' task #',nt
        CALL MPI_ISSEND(INFO,6,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &  
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO sh_loop
!
!-------------
!***  South V
!-------------
!
      HANDLE_PACKET=>HANDLE_PACKET_S_V(ID)%CHILDREN(N)%DATA
!
      sv_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:5,NT,2)                     !<-- South V info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_V_S(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_V_S(N)                                   !<-- Look for a child task with south boundary V points
            ID_CHILDTASK=CHILDTASK_BNDRY_V_RANKS(N)%SOUTH(NTX,1)           !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ south boundary V points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=22222+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_V_SAVE(N)%I_LO_SOUTH(NTX)                  !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_V_SAVE(N)%I_HI_SOUTH(NTX)                  !<-- Save the ending index of boundary segment on child
              INFO(4)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(5)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Sbndry task
                             ,5                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE sv_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no south boundary H points
        NTAG_SEND=22222+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,5,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO sv_loop
!
!-------------
!***  North H
!-------------
!
      HANDLE_PACKET=>HANDLE_PACKET_N_H(ID)%CHILDREN(N)%DATA
!
      nh_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:6,NT,3)                     !<-- North H info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_H_N(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_H_N(N)                                   !<-- Look for a child task with north boundary H points
            ID_CHILDTASK=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NTX,1)           !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ north boundary H points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=33333+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_H_SAVE(N)%I_LO_NORTH(NTX)                  !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_H_SAVE(N)%I_HI_NORTH_TRANSFER(NTX)         !<-- Save the ending index of boundary segment on child
              INFO(4)=CHILDTASK_H_SAVE(N)%I_HI_NORTH(NTX)                  !<-- Save the ending index of expanded boundary segment on child
              INFO(5)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(6)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Nbndry task
                             ,6                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE nh_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no north boundary H points
        NTAG_SEND=33333+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,6,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &  
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO nh_loop
!
!-------------
!***  North V
!-------------
!
      HANDLE_PACKET=>HANDLE_PACKET_N_V(ID)%CHILDREN(N)%DATA
!
      nv_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:5,NT,4)                     !<-- North V info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_V_N(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_V_N(N)                                   !<-- Look for a child task with north boundary V points
            ID_CHILDTASK=CHILDTASK_BNDRY_V_RANKS(N)%NORTH(NTX,1)           !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ north boundary V points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=44444+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_V_SAVE(N)%I_LO_NORTH(NTX)                  !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_V_SAVE(N)%I_HI_NORTH(NTX)                  !<-- Save the ending index of boundary segment on child
              INFO(4)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(5)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Nbndry task
                             ,5                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE nv_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no north boundary V points
        NTAG_SEND=44444+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,5,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO nv_loop
!
!------------
!***  West H
!------------
!
      HANDLE_PACKET=>HANDLE_PACKET_W_H(ID)%CHILDREN(N)%DATA
!
      wh_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:6,NT,5)                     !<-- West H info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_H_W(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_H_W(N)                                   !<-- Look for a child task with west boundary H points
            ID_CHILDTASK=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NTX,1)            !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ west boundary H points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=CHILD_RANKS(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=55555+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_H_SAVE(N)%J_LO_WEST(NTX)                   !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_H_SAVE(N)%J_HI_WEST_TRANSFER(NTX)          !<-- Save the ending index of boundary segment on child
              INFO(4)=CHILDTASK_H_SAVE(N)%J_HI_WEST(NTX)                   !<-- Save the ending index of expanded boundary segment on child
              INFO(5)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(6)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Wbndry task
                             ,6                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE wh_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no west boundary H points
        NTAG_SEND=55555+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,6,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
!                      ,55555,COMM_TO_MY_CHILDREN(N)                    &  
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &  
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO wh_loop
!
!------------
!***  West V
!------------
!
      HANDLE_PACKET=>HANDLE_PACKET_W_V(ID)%CHILDREN(N)%DATA
!
      wv_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:5,NT,6)                     !<-- West V info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_V_W(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_V_W(N)                                   !<-- Look for a child task with west boundary V points
            ID_CHILDTASK=CHILDTASK_BNDRY_V_RANKS(N)%WEST(NTX,1)            !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ west boundary V points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=66666+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_V_SAVE(N)%J_LO_WEST(NTX)                   !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_V_SAVE(N)%J_HI_WEST(NTX)                   !<-- Save the ending index of boundary segment on child
              INFO(4)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(5)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Wbndry task
                             ,5                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE wv_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no west boundary V points
        NTAG_SEND=66666+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,5,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
!                      ,66666,COMM_TO_MY_CHILDREN(N)                    &
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO wv_loop
!
!------------
!***  East H
!------------
!
      HANDLE_PACKET=>HANDLE_PACKET_E_H(ID)%CHILDREN(N)%DATA
!
      eh_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:6,NT,7)                     !<-- East H info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_H_E(N)>0)THEN
!
          DO NTX=1,NUM_TASKS_SEND_H_E(N)                                   !<-- Look for a child task with east boundary H points
            ID_CHILDTASK=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NTX,1)            !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ east boundary H points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=77777+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_H_SAVE(N)%J_LO_EAST(NTX)                   !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_H_SAVE(N)%J_HI_EAST_TRANSFER(NTX)          !<-- Save the ending index of boundary segment on child
              INFO(4)=CHILDTASK_H_SAVE(N)%J_HI_EAST(NTX)                   !<-- Save the ending index of expanded boundary segment on child
              INFO(5)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(6)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Ebndry task
                             ,6                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE eh_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no east boundary H points
        NTAG_SEND=77777+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,6,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &  
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO eh_loop
!
!------------
!***  East V
!------------
!
      HANDLE_PACKET=>HANDLE_PACKET_E_V(ID)%CHILDREN(N)%DATA
!
      ev_loop: DO NT=0,FTASKS_DOMAIN(ID_CHILD)-1                           !<-- Each parent task loops through all tasks on each child
!
        CALL MPI_WAIT(HANDLE_PACKET(NT)                                 &  !<-- Be sure the previous send is complete.
                     ,JSTAT                                             &
                     ,IERR )
!
        INFO=>INFO_SEND(ID)%CHILDREN(N)%INFO(1:5,NT,8)                     !<-- East V info to child N's task NT
!
        INFO(1)=-1
!
        IF(NUM_TASKS_SEND_V_E(N)>0)THEN                                
!
          DO NTX=1,NUM_TASKS_SEND_V_E(N)                                   !<-- Look for a child task with east boundary V points
            ID_CHILDTASK=CHILDTASK_BNDRY_V_RANKS(N)%EAST(NTX,1)            !<-- Count of this child task in list of all fcst tasks
!              
            IF(NT==ID_CHILDTASK-1)THEN                                     !<-- If yes, we found a child task w/ east boundary V points
              NRANK=ID_CHILDTASK-1
              ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NRANK)         !<-- Local rank of child task NTX in p-c intracomm
              NTAG_SEND=88888+ID_CHILDTASK+ID_ADD                          !<-- Combine child task rank and child domain ID for unique tag
!
              INFO(1)=MYPE                                                 !<-- Save the parent task rank
              INFO(2)=CHILDTASK_V_SAVE(N)%J_LO_EAST(NTX)                   !<-- Save the starting index of boundary segment on child
              INFO(3)=CHILDTASK_V_SAVE(N)%J_HI_EAST(NTX)                   !<-- Save the ending index of boundary segment on child
              INFO(4)=ID_CHILDTASK                                         !<-- Save the target child task rank
              INFO(5)=ID_CHILD                                             !<-- Save the domain ID of the target child task
!
              CALL MPI_ISSEND(INFO                                       &  !<-- Parent task sends the key data to the child Ebndry task
                             ,5                                          &  !<-- # of words
                             ,MPI_INTEGER                                &  !<-- Datatype
                             ,ID_CHILDTASK                               &  !<-- Rank of target child task in parent-child intracomm
                             ,NTAG_SEND                                  &  !<-- Tag for south boundary H points
                             ,COMM_TO_MY_CHILDREN(N)                     &  !<-- Parent-child intracommunicator
                             ,HANDLE_PACKET(NT)                          &  !<-- Request handle for this ISend
                             ,IERR)
!
              CYCLE ev_loop                                                !<-- Move on to next child task
            ENDIF
          ENDDO
!
        ENDIF
!
        ID_CHILDTASK=child_ranks(ID)%CHILDREN(N)%DATA(NT)                  !<-- This child task has no east boundary V points
        NTAG_SEND=88888+ID_CHILDTASK+ID_ADD                                !<-- Combine child task rank and child domain ID for unique tag
!
        CALL MPI_ISSEND(INFO,5,MPI_INTEGER,ID_CHILDTASK                 &  !<-- Then send this child task some dummy information
                       ,NTAG_SEND,COMM_TO_MY_CHILDREN(N)                &
                       ,HANDLE_PACKET(NT),IERR)
!
      ENDDO ev_loop
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_SENDS_CHILD_DATA_LIMITS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE CHILD_RECVS_CHILD_DATA_LIMITS(EXP_STATE                &
                                              ,MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Children receive from their parents basic bookkeeping information
!***  needed for the exchange of boundary data during the integration.
!***  The routine in which the parents send this data is
!***  PARENT_SENDS_CHILD_DATA_LIMITS.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: MY_DOMAIN_ID                        !<-- The current domain's ID
!
      TYPE(ESMF_State),INTENT(INOUT) :: EXP_STATE                           !<-- Parent-Child Coupler export state
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ID_ADD,ID_DOM,KOUNT,LB,LENGTH,N,N1,NBASE    &
                           ,NTAG_RECV,NV,UB
!
      INTEGER(kind=KINT) :: ILIM_HI,ILIM_LO,JLIM_HI,JLIM_LO
!
      INTEGER(kind=KINT) :: IERR,ISTAT,RC,RC_LIMITS 
!
      INTEGER(kind=KINT),DIMENSION(6) :: INFO_R=(/-9999,0,0,0,0,0/)
      INTEGER(kind=KINT),DIMENSION(4) :: TEMP
      INTEGER(kind=KINT),DIMENSION(4,2) :: PARENT_INFO
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: STATUS
!
      TYPE(COMPOSITE),POINTER :: CC
!
      integer(kind=kint),dimension(8) :: values
      integer(kind=kint) :: my_rank,source,tag
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  The child tasks receive the key information from their
!***  parent tasks.  At this point the child tasks do not know
!***  the local ranks of the parent tasks that will be sending
!***  information to them thus MPI_ANY_SOURCE is used in the
!***  receive.  However this means that when there are two
!***  parent tasks sending to a nest task (rather than only one)
!***  then the two overlap points on the nest boundary segment
!***  computed by the parent tasks will ultimately have values
!***  depending on which parent task's preliminary information
!***  is received last in the MPI_ANY_SOURCE Recv below.  Since
!***  the values in those overlap points are not bit identical
!***  then any successive runs can have slightly different answers.
!***  To avoid that happening when two parent tasks are sending,
!***  the child task will receive their ranks and then put them
!***  in ascending order so that all subsequent updates of the
!***  nest boundary overlap points are always done in the same
!***  way regardless of the order the preliminary information
!***  is received with MPI_ANY_SOURCE.
!
!***  All nests execute this routine once during the Init step and
!***  then again on those parent timesteps during the Run step when
!***  the child has moved. 
!-----------------------------------------------------------------------
!
      CALL MPI_COMM_RANK(COMM_TO_MY_PARENT,MYPE,IERR)                      !<-- Obtain local rank of child task in p-c intracomm
      ID_DOM=ID_PARENTS(MY_DOMAIN_ID)                                      !<-- Domain ID of this child's parent
      ID_ADD=1000*MY_DOMAIN_ID
!
!-------------
!***  South H
!-------------
!
      KOUNT=0
      INDX_MIN_H%SOUTH= 1000000
      INDX_MAX_H%SOUTH=-1000000
      NTAG_RECV=11111+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
!     write(0,12711)my_domain_id,mype,n,ntag_recv,id_add
12711 format(' CHILD_RECVS_CHILD_DATA_LIMITS my_domain_id=',i2,' mype=',i3,' ready to recv SH from parent task ',i3,' tag=',i6,' id_add=',i5)
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,6                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,11111                                             &  !<-- Tag used for south boundary H points
                     ,NTAG_RECV                                         &  !<-- Tag used for south boundary H points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!     write(0,12712)n,info_r(1)
12712 format(' recvd SH from parent task ',i3,' info_r(1)=',6(1x,i5))
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task sent key preliminary bndry info
!
          IF(INFO_R(5)/=MYPE.OR.INFO_R(6)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd South H data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(5),' on domain ',INFO_R(6)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,4
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
!     write(0,*)' CHILD_RECVS_CHILD_DATA_LIMITS south_h info_r=',info_r,' kount=',kount
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,4                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%SOUTH_H%ID_SOURCE   =PARENT_INFO(1,N)             !<-- Rank of parent task that will send Sboundary H data segment
          PARENT_TASK(N)%SOUTH_H%INDX_START  =PARENT_INFO(2,N)             !<-- Istart on child grid of the boundary data segment
          PARENT_TASK(N)%SOUTH_H%INDX_END    =PARENT_INFO(3,N)             !<-- Iend on child grid of the boundary data segment
          PARENT_TASK(N)%SOUTH_H%INDX_END_EXP=PARENT_INFO(4,N)             !<-- Iend on child grid of the expanded boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_H
          LENGTH=NLEV_H*NBASE
!
          PARENT_TASK(N)%SOUTH_H%LENGTH=LENGTH                             !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%SOUTH_H%STRING(1:LENGTH))                !<-- Sboundary H datastring to be received from parent task
!
          INDX_MIN_H%SOUTH=MIN(INDX_MIN_H%SOUTH,PARENT_INFO(2,N))          !<-- Starting child I for union of parent task segments sent  
          INDX_MAX_H%SOUTH=MAX(INDX_MAX_H%SOUTH,PARENT_INFO(3,N))          !<-- Ending child I for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_H%SOUTH=KOUNT
!!!   LENGTH_BND_SEG_H%SOUTH=INDX_MAX_H%SOUTH-INDX_MIN_H%SOUTH+1
!
      south_h: IF(NUM_PARENT_TASKS_SENDING_H%SOUTH>0)THEN                  !<-- Does this child task recv Sboundary H data from parent?
!
        ALLOCATE(cc%PDB_S(INDX_MIN_H%SOUTH:INDX_MAX_H%SOUTH,1:N_BLEND_H))      !<-- Full PDB south H boundary segment on this child task
!
        IF(NVARS_BC_2D_H>1)THEN
          DO NV=1,NVARS_BC_2D_H-1  
            ALLOCATE(cc%MY_BC_VARS_H_S%VAR_2D(NV)%SIDE(INDX_MIN_H%SOUTH:INDX_MAX_H%SOUTH,1:N_BLEND_H)) !<-- 2-D BC H-pt vbls except PD
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            ALLOCATE(cc%MY_BC_VARS_H_S%VAR_3D(NV)%SIDE(INDX_MIN_H%SOUTH:INDX_MAX_H%SOUTH,1:N_BLEND_H,1:LM)) !<-- 3-D BC H-pt vbls
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            ALLOCATE(cc%MY_BC_VARS_H_S%VAR_4D(NV)%SIDE(INDX_MIN_H%SOUTH:INDX_MAX_H%SOUTH,1:N_BLEND_H,1:LM,LB:UB)) !<-- 4-D BC H-pt vbls
          ENDDO
        ENDIF
!
        ILIM_LO=INDX_MIN_H%SOUTH
        ILIM_HI=INDX_MAX_H%SOUTH
        JLIM_LO=1
        JLIM_HI=N_BLEND_H
!
        LENGTH=NLEV_H*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_SOUTH_H(1:LENGTH),stat=ISTAT)                 !<-- 1-D combined H-point data on child task's Sbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_SOUTH_H'                  &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_SOUTH_H'                  &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_SOUTH_H'                  &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_SOUTH_H'                  &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF south_h
!
!-----------------------------------------------------------------------
!
!-------------
!***  South V
!-------------
!
      KOUNT=0
      INDX_MIN_V%SOUTH= 1000000
      INDX_MAX_V%SOUTH=-1000000
      NTAG_RECV=22222+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,5                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,22222                                             &  !<-- Tag used for south boundary V points
                     ,NTAG_RECV                                         &  !<-- Tag used for south boundary V points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(4)/=MYPE.OR.INFO_R(5)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd South V data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(4),' on domain ',INFO_R(5)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,3
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,3                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%SOUTH_V%ID_SOURCE =PARENT_INFO(1,N)               !<-- Rank of parent task that will send Sboundary V data segment
          PARENT_TASK(N)%SOUTH_V%INDX_START=PARENT_INFO(2,N)               !<-- Istart on child grid of the boundary data segment
          PARENT_TASK(N)%SOUTH_V%INDX_END  =PARENT_INFO(3,N)               !<-- Iend on child grid of the boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_V
          LENGTH=NLEV_V*NBASE
!
          PARENT_TASK(N)%SOUTH_V%LENGTH=LENGTH                             !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%SOUTH_V%STRING(1:LENGTH))                !<-- Sboundary V datastring to be received from parent task
!
          INDX_MIN_V%SOUTH=MIN(INDX_MIN_V%SOUTH,PARENT_INFO(2,N))          !<-- Starting child I for union of parent task segments sent
          INDX_MAX_V%SOUTH=MAX(INDX_MAX_V%SOUTH,PARENT_INFO(3,N))          !<-- Ending child I for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_V%SOUTH=KOUNT
!!!   LENGTH_BND_SEG_V%SOUTH=INDX_MAX_V%SOUTH-INDX_MIN_V%SOUTH+1
!
      south_v: IF(NUM_PARENT_TASKS_SENDING_V%SOUTH>0)THEN                  !<-- Does this child task recv any Sboundary V data from parent?
!
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            ALLOCATE(cc%MY_BC_VARS_V_S%VAR_2D(NV)%SIDE(INDX_MIN_V%SOUTH:INDX_MAX_V%SOUTH,1:N_BLEND_V)) !<-- 2-D vbls on this child task's
                                                                                                       !    south V bndry segment.
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            ALLOCATE(cc%MY_BC_VARS_V_S%VAR_3D(NV)%SIDE(INDX_MIN_V%SOUTH:INDX_MAX_V%SOUTH,1:N_BLEND_V,1:LM)) !<-- 3-D vbls on this child task's
                                                                                                            !    south V bndry segment.
          ENDDO
        ENDIF
!
        ILIM_LO=INDX_MIN_V%SOUTH
        ILIM_HI=INDX_MAX_V%SOUTH
        JLIM_LO=1
        JLIM_HI=N_BLEND_V
!
        LENGTH=NLEV_V*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_SOUTH_V(1:LENGTH),stat=ISTAT)                 !<-- 1-D combined V-point data on child task's Sbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_SOUTH_V'                  &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_SOUTH_V'                  &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_SOUTH_V'                  &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_SOUTH_V'                  &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF south_v
!
!-----------------------------------------------------------------------
!
!-------------
!***  North H
!-------------
!
      KOUNT=0
      INDX_MIN_H%NORTH= 1000000
      INDX_MAX_H%NORTH=-1000000
      NTAG_RECV=33333+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,6                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,33333                                             &  !<-- Tag used for north boundary H points
                     ,NTAG_RECV                                         &  !<-- Tag used for north boundary H points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(5)/=MYPE.OR.INFO_R(6)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd North H data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(5),' on domain ',INFO_R(6)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,4
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,4                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%NORTH_H%ID_SOURCE   =PARENT_INFO(1,N)             !<-- Rank of parent task that will send Nboundary H data segment
          PARENT_TASK(N)%NORTH_H%INDX_START  =PARENT_INFO(2,N)             !<-- Istart on child grid of the boundary data segment
          PARENT_TASK(N)%NORTH_H%INDX_END    =PARENT_INFO(3,N)             !<-- Iend on child grid of the boundary data segment
          PARENT_TASK(N)%NORTH_H%INDX_END_EXP=PARENT_INFO(4,N)             !<-- Iend on child grid of the expanded boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_H
          LENGTH=NLEV_H*NBASE
!
          PARENT_TASK(N)%NORTH_H%LENGTH=LENGTH                             !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%NORTH_H%STRING(1:LENGTH))                !<-- Nboundary H datastring to be received from parent task
!
          INDX_MIN_H%NORTH=MIN(INDX_MIN_H%NORTH,PARENT_INFO(2,N))          !<-- Starting child I for union of parent task segments sent
          INDX_MAX_H%NORTH=MAX(INDX_MAX_H%NORTH,PARENT_INFO(3,N))          !<-- Ending child I for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_H%NORTH=KOUNT
!!!   LENGTH_BND_SEG_H%NORTH=INDX_MAX_H%NORTH-INDX_MIN_H%NORTH+1
!
      north_h: IF(NUM_PARENT_TASKS_SENDING_H%NORTH>0)THEN                  !<-- Does this child task recv Nboundary H data from parent?
!
        ALLOCATE(cc%PDB_N(INDX_MIN_H%NORTH:INDX_MAX_H%NORTH,1:N_BLEND_H))
!
        IF(NVARS_BC_2D_H>1)THEN
          DO NV=1,NVARS_BC_2D_H-1
            ALLOCATE(cc%MY_BC_VARS_H_N%VAR_2D(NV)%SIDE(INDX_MIN_H%NORTH:INDX_MAX_H%NORTH,1:N_BLEND_H)) !<-- 2-D BC H-pt vbls except PD
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            ALLOCATE(cc%MY_BC_VARS_H_N%VAR_3D(NV)%SIDE(INDX_MIN_H%NORTH:INDX_MAX_H%NORTH,1:N_BLEND_H,1:LM)) !<-- 3-D BC H-pt vbls
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            ALLOCATE(cc%MY_BC_VARS_H_N%VAR_4D(NV)%SIDE(INDX_MIN_H%NORTH:INDX_MAX_H%NORTH,1:N_BLEND_H,1:LM,LB:UB)) !<-- 4-D BC H-pt vbls
          ENDDO
        ENDIF
!
        ILIM_LO=INDX_MIN_H%NORTH
        ILIM_HI=INDX_MAX_H%NORTH
        JLIM_LO=1
        JLIM_HI=N_BLEND_H
!
        LENGTH=NLEV_H*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_NORTH_H(1:LENGTH),stat=ISTAT)                 !<-- 1-D combined H-point data on child task's Nbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_NORTH_H'                  &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_NORTH_H'                  &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_NORTH_H'                  &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_NORTH_H'                  &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF north_h
!
!-----------------------------------------------------------------------
!
!-------------
!***  North V
!-------------
!
      KOUNT=0
      INDX_MIN_V%NORTH= 1000000
      INDX_MAX_V%NORTH=-1000000
      NTAG_RECV=44444+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,5                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,44444                                             &  !<-- Tag used for north boundary V points
                     ,NTAG_RECV                                         &  !<-- Tag used for north boundary V points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(4)/=MYPE.OR.INFO_R(5)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd North V data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(4),' on domain ',INFO_R(5)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
!   if(kount>2)then
!     write(0,*)' BUG: exceeded two parent tasks sending to this child bndry task'
!   endif
          DO N1=1,3
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
!!!!!!!!!!!!!!!!!!!!!!!debug
!                    else
!   write(0,*)' PARENT_TO_CHILD_DATA_LIMITS child recvd dummy north V from parent task #n=',n,' with id=',-1*info_r(1)
!!!!!!!!!!!!!!!!!!!!!!!debug
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,3                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%NORTH_V%ID_SOURCE =PARENT_INFO(1,N)               !<-- Rank of parent task that will send Nboundary V data segment
          PARENT_TASK(N)%NORTH_V%INDX_START=PARENT_INFO(2,N)               !<-- Istart on child grid of the boundary data segment
          PARENT_TASK(N)%NORTH_V%INDX_END  =PARENT_INFO(3,N)               !<-- Iend on child grid of the boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_V
          LENGTH=NLEV_V*NBASE
!
          PARENT_TASK(N)%NORTH_V%LENGTH=LENGTH                             !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%NORTH_V%STRING(1:LENGTH))                !<-- Nboundary V datastring to be received from parent task
!
          INDX_MIN_V%NORTH=MIN(INDX_MIN_V%NORTH,PARENT_INFO(2,N))          !<-- Starting child I for union of parent task segments sent
          INDX_MAX_V%NORTH=MAX(INDX_MAX_V%NORTH,PARENT_INFO(3,N))          !<-- Ending child I for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_V%NORTH=KOUNT
!!!   LENGTH_BND_SEG_V%NORTH=INDX_MAX_V%NORTH-INDX_MIN_V%NORTH+1
!
      north_v: IF(NUM_PARENT_TASKS_SENDING_V%NORTH>0)THEN                  !<-- Does this child task recv any Nboundary V data from parent?
!
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            ALLOCATE(cc%MY_BC_VARS_V_N%VAR_2D(NV)%SIDE(INDX_MIN_V%NORTH:INDX_MAX_V%NORTH,1:N_BLEND_V)) !<-- 2-D vbls on this child task's
                                                                                                       !    north V bndry segment.
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            ALLOCATE(cc%MY_BC_VARS_V_N%VAR_3D(NV)%SIDE(INDX_MIN_V%NORTH:INDX_MAX_V%NORTH,1:N_BLEND_V,1:LM)) !<-- 3-D vbls on this child task's
                                                                                                            !    north V bndry segment.
          ENDDO
        ENDIF
!
        ILIM_LO=INDX_MIN_V%NORTH
        ILIM_HI=INDX_MAX_V%NORTH
        JLIM_LO=1
        JLIM_HI=N_BLEND_V
!
        LENGTH=NLEV_V*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_NORTH_V(1:LENGTH),stat=ISTAT)                 !<-- 1-D combined V-point data on child task's Nbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_NORTH_V'                  &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_NORTH_V'                  &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_NORTH_V'                  &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_NORTH_V'                  &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF north_v
!
!-----------------------------------------------------------------------
!
!------------
!***  West H
!------------
!
      KOUNT=0
      INDX_MIN_H%WEST= 1000000
      INDX_MAX_H%WEST=-1000000
      NTAG_RECV=55555+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,6                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,55555                                             &  !<-- Tag used for west boundary H points
                     ,NTAG_RECV                                         &  !<-- Tag used for west boundary H points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(5)/=MYPE.OR.INFO_R(6)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd West H data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(5),' on domain ',INFO_R(6)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,4
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,4                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%WEST_H%ID_SOURCE   =PARENT_INFO(1,N)              !<-- Rank of parent task that will send Wboundary H data segment
          PARENT_TASK(N)%WEST_H%INDX_START  =PARENT_INFO(2,N)              !<-- Jstart on child grid of the boundary data segment
          PARENT_TASK(N)%WEST_H%INDX_END    =PARENT_INFO(3,N)              !<-- Jend on child grid of the boundary data segment
          PARENT_TASK(N)%WEST_H%INDX_END_EXP=PARENT_INFO(4,N)              !<-- Jend on child grid of the expanded boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_H
          LENGTH=NLEV_H*NBASE
!
          PARENT_TASK(N)%WEST_H%LENGTH=LENGTH                              !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%WEST_H%STRING(1:LENGTH))                 !<-- Wboundary H datastring to be received from parent task
!
          INDX_MIN_H%WEST=MIN(INDX_MIN_H%WEST,PARENT_INFO(2,N))            !<-- Starting child J for union of parent task segments sent
          INDX_MAX_H%WEST=MAX(INDX_MAX_H%WEST,PARENT_INFO(3,N))            !<-- Ending child J for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_H%WEST=KOUNT
!!!   LENGTH_BND_SEG_H%WEST=INDX_MAX_H%WEST-INDX_MIN_H%WEST+1
!
      west_h: IF(NUM_PARENT_TASKS_SENDING_H%WEST>0)THEN                    !<-- Does this child task recv Wboundary H data from parent?
!
        ALLOCATE(cc%PDB_W(1:N_BLEND_H,INDX_MIN_H%WEST:INDX_MAX_H%WEST))
!
        IF(NVARS_BC_2D_H>1)THEN
          DO NV=1,NVARS_BC_2D_H-1
            ALLOCATE(cc%MY_BC_VARS_H_W%VAR_2D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%WEST:INDX_MAX_H%WEST)) !<-- 2-D BC H-pt vbls except PD
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            ALLOCATE(cc%MY_BC_VARS_H_W%VAR_3D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%WEST:INDX_MAX_H%WEST,1:LM)) !<-- 3-D BC H-pt vbls
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            ALLOCATE(cc%MY_BC_VARS_H_W%VAR_4D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%WEST:INDX_MAX_H%WEST,1:LM,LB:UB)) !<-- 4-D BC H-pt vbls
          ENDDO
        ENDIF
!
        ILIM_LO=1
        ILIM_HI=N_BLEND_H
        JLIM_LO=INDX_MIN_H%WEST
        JLIM_HI=INDX_MAX_H%WEST
!
        LENGTH=NLEV_H*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_WEST_H(1:LENGTH),stat=ISTAT)                  !<-- 1-D combined H-point data on child task's Wbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_WEST_H'                   &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_WEST_H'                   &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_WEST_H'                   &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_WEST_H'                   &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF west_h
!
!-----------------------------------------------------------------------
!
!------------
!***  West V
!------------
!
      KOUNT=0
      INDX_MIN_V%WEST= 1000000
      INDX_MAX_V%WEST=-1000000
      NTAG_RECV=66666+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,5                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,66666                                             &  !<-- Tag used for west boundary V points
                     ,NTAG_RECV                                         &  !<-- Tag used for west boundary V points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(4)/=MYPE.OR.INFO_R(5)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd West V data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(4),' on domain ',INFO_R(5)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,3
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,3                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%WEST_V%ID_SOURCE =PARENT_INFO(1,N)                !<-- Rank of parent task that will send Wboundary V data segment
          PARENT_TASK(N)%WEST_V%INDX_START=PARENT_INFO(2,N)                !<-- Jstart on child grid of the boundary data segment
          PARENT_TASK(N)%WEST_V%INDX_END  =PARENT_INFO(3,N)                !<-- Jend on child grid of the boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_V
          LENGTH=NLEV_V*NBASE
!
          PARENT_TASK(N)%WEST_V%LENGTH=LENGTH                              !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%WEST_V%STRING(1:LENGTH))                 !<-- Wboundary V datastring to be received from parent task
!
          INDX_MIN_V%WEST=MIN(INDX_MIN_V%WEST,PARENT_INFO(2,N))            !<-- Starting child J for union of parent task segments sent
          INDX_MAX_V%WEST=MAX(INDX_MAX_V%WEST,PARENT_INFO(3,N))            !<-- Ending child J for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_V%WEST=KOUNT
!!!   LENGTH_BND_SEG_V%WEST=INDX_MAX_V%WEST-INDX_MIN_V%WEST+1
!
      west_v: IF(NUM_PARENT_TASKS_SENDING_V%WEST>0)THEN                    !<-- Does this child task recv Wboundary V data from parent?
!
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            ALLOCATE(cc%MY_BC_VARS_V_W%VAR_2D(NV)%SIDE(1:N_BLEND_V,INDX_MIN_V%WEST:INDX_MAX_V%WEST)) !<-- 2-D vbls on this child task's
                                                                                                     !    west V bndry segment.
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            ALLOCATE(cc%MY_BC_VARS_V_W%VAR_3D(NV)%SIDE(1:N_BLEND_V,INDX_MIN_V%WEST:INDX_MAX_V%WEST,1:LM)) !<-- 3-D vbls on this child task's
                                                                                                          !    west V bndry segment.
          ENDDO
        ENDIF
!
        ILIM_LO=1
        ILIM_HI=N_BLEND_V
        JLIM_LO=INDX_MIN_V%WEST
        JLIM_HI=INDX_MAX_V%WEST
!
        LENGTH=NLEV_V*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_WEST_V(1:LENGTH),stat=ISTAT)                  !<-- 1-D combined V-point data on child task's Wbndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_WEST_V'                   &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_WEST_V'                   &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_WEST_V'                   &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_WEST_V'                   &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF west_v
!
!-----------------------------------------------------------------------
!
!------------
!***  East H
!------------
!
      KOUNT=0
      INDX_MIN_H%EAST= 1000000
      INDX_MAX_H%EAST=-1000000
      NTAG_RECV=77777+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
!         call date_and_time(values=values)
!         write(0,9876)values(5),values(6),values(7),values(8)
 9876     format(' Ready to recv E_H info from parent tasks at ',i2.2,':',i2.2,':',i2.2,'.',i3.3)
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,6                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,77777                                             &  !<-- Tag used for east boundary H points
                     ,NTAG_RECV                                         &  !<-- Tag used for east boundary H points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!
!     source = status(MPI_SOURCE)
!     tag = status(MPI_TAG)
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
!         IF(INFO_R(5)/=MYPE.OR.INFO_R(6)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
!           WRITE(0,*)' Recvd East H data that is not mine!!'
!           WRITE(0,*)' Parent data sent to child task ',INFO_R(5),' on domain ',INFO_R(6)
!           WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
!           write(0,*)' source=',source,' tag=',tag
!           CYCLE                                                          !<-- If not then move on to next parent task's data.
!         ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,4
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,4                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
          PARENT_TASK(N)%EAST_H%ID_SOURCE   =PARENT_INFO(1,N)              !<-- Rank of parent task that will send Eboundary H data segment
          PARENT_TASK(N)%EAST_H%INDX_START  =PARENT_INFO(2,N)              !<-- Jstart on child grid of the boundary data segment
          PARENT_TASK(N)%EAST_H%INDX_END    =PARENT_INFO(3,N)              !<-- Jend on child grid of the boundary data segment
          PARENT_TASK(N)%EAST_H%INDX_END_EXP=PARENT_INFO(4,N)              !<-- Jend on child grid of the expanded boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_H
          LENGTH=NLEV_H*NBASE
!
          PARENT_TASK(N)%EAST_H%LENGTH=LENGTH                              !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%EAST_H%STRING(1:LENGTH))                 !<-- Eboundary H datastring to be received from parent task
!
          INDX_MIN_H%EAST=MIN(INDX_MIN_H%EAST,PARENT_INFO(2,N))            !<-- Starting child J for union of parent task segments sent
          INDX_MAX_H%EAST=MAX(INDX_MAX_H%EAST,PARENT_INFO(3,N))            !<-- Ending child J for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_H%EAST=KOUNT
!!!   LENGTH_BND_SEG_H%EAST=INDX_MAX_H%EAST-INDX_MIN_H%EAST+1
!
      east_h: IF(NUM_PARENT_TASKS_SENDING_H%EAST>0)THEN                    !<-- Does this child task recv Eboundary H data from parent?
!
        ALLOCATE(cc%PDB_E(1:N_BLEND_H,INDX_MIN_H%EAST:INDX_MAX_H%EAST))
!
        IF(NVARS_BC_2D_H>1)THEN
          DO NV=1,NVARS_BC_2D_H-1
            ALLOCATE(cc%MY_BC_VARS_H_E%VAR_2D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%EAST:INDX_MAX_H%EAST)) !<-- 2-D BC H-pt vbls except PD
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            ALLOCATE(cc%MY_BC_VARS_H_E%VAR_3D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%EAST:INDX_MAX_H%EAST,1:LM)) !<-- 3-D BC H-pt vbls
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            ALLOCATE(cc%MY_BC_VARS_H_E%VAR_4D(NV)%SIDE(1:N_BLEND_H,INDX_MIN_H%EAST:INDX_MAX_H%EAST,1:LM,LB:UB)) !<-- 4-D BC H-pt vbls
          ENDDO
        ENDIF
!
        ILIM_LO=1
        ILIM_HI=N_BLEND_H
        JLIM_LO=INDX_MIN_H%EAST
        JLIM_HI=INDX_MAX_H%EAST
!
        LENGTH=NLEV_H*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)
        ALLOCATE(cc%BOUND_1D_EAST_H(1:LENGTH),stat=ISTAT)                  !<-- 1-D combined H-point data on child task's Ebndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_EAST_H'                   &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_EAST_H'                   &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_EAST_H'                   &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry H Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_EAST_H'                   &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF east_h
!
!-----------------------------------------------------------------------
!
!------------
!***  East V
!------------
!
      KOUNT=0
      INDX_MIN_V%EAST= 1000000
      INDX_MAX_V%EAST=-1000000
      NTAG_RECV=88888+MYPE+ID_ADD                                          !<-- Combine child task rank and child domain ID for unique tag
!
      DO N=0,FTASKS_DOMAIN(ID_DOM)-1                                       !<-- Child task loops through its parent's tasks
!
        CALL MPI_RECV(INFO_R                                            &  !<-- Receive data packet from each parent task
                     ,5                                                 &  !<-- # of words in data packet
                     ,MPI_INTEGER                                       &  !<-- Datatype
                     ,N                                                 &  !<-- Rank of parent task that is sending
!                    ,88888                                             &  !<-- Tag used for east boundary V points
                     ,NTAG_RECV                                         &  !<-- Tag used for east boundary V points
                     ,COMM_TO_MY_PARENT                                 &  !<-- MPI intracommunicator between child and parent
                     ,STATUS                                            &  !<-- Status of Recv
                     ,IERR)
!     source=status(mpi_source)
!     tag=status(mpi_tag)
!     write(0,*)' parent task #',n,' source=',source,' info_r(1)=',info_r(1),' (2)=',info_r(2),' (3)=',info_r(3),' (4)=',info_r(4) &
!                                                   ,' (5)=',info_r(5)
!
        IF(INFO_R(1)>=0)THEN                                               !<-- If yes, this parent task has key preliminary bndry info
!
          IF(INFO_R(4)/=MYPE.OR.INFO_R(5)/=MY_DOMAIN_ID)THEN               !<-- Is data really for my task on this domain?
            WRITE(0,*)' Recvd East V data that is not mine!!'
            WRITE(0,*)' Parent data sent to child task ',INFO_R(4),' on domain ',INFO_R(5)
            WRITE(0,*)' But I am child task ',MYPE,' on domain ID ',MY_DOMAIN_ID
!           WRITE(0,*)' Message was sent from task ',source,' with tag=',tag
            CYCLE                                                          !<-- If not then move on to next parent task's data.
          ENDIF
!
          KOUNT=KOUNT+1
          DO N1=1,3
            PARENT_INFO(N1,KOUNT)=INFO_R(N1)                               !<-- Save the data from that parent task
          ENDDO
        ENDIF
!
      ENDDO
!
      IF(KOUNT==2)THEN                                                     !<-- Nest task recvs data from two parent tasks
        IF(PARENT_INFO(1,1)>PARENT_INFO(1,2))THEN                          !<-- Data recvd from 'out of order' parent tasks
!
          DO N1=1,3                                                        !<-- Save parent data in order of ascending task IDs
            TEMP(N1)         =PARENT_INFO(N1,1)                            !
            PARENT_INFO(N1,1)=PARENT_INFO(N1,2)                            !
            PARENT_INFO(N1,2)=TEMP(N1)                                     !<--
          ENDDO
!
        ENDIF
      ENDIF
!
      IF(KOUNT>0)THEN
        DO N=1,KOUNT
!
          PARENT_TASK(N)%EAST_V%ID_SOURCE =PARENT_INFO(1,N)                !<-- Rank of parent task that will send Eboundary V data segment
          PARENT_TASK(N)%EAST_V%INDX_START=PARENT_INFO(2,N)                !<-- Jstart on child grid of the boundary data segment
          PARENT_TASK(N)%EAST_V%INDX_END  =PARENT_INFO(3,N)                !<-- Jend on child grid of the boundary data segment
!
          NBASE =(PARENT_INFO(3,N)-PARENT_INFO(2,N)+1)*N_BLEND_V
          LENGTH=NLEV_V*NBASE
!
          PARENT_TASK(N)%EAST_V%LENGTH=LENGTH                              !<-- # of words in this parent task's datastring of child bndry
!
          ALLOCATE(PARENT_TASK(N)%EAST_V%STRING(1:LENGTH))                 !<-- Eboundary V datastring to be received from parent task
!
          INDX_MIN_V%EAST=MIN(INDX_MIN_V%EAST,PARENT_INFO(2,N))            !<-- Starting child J for union of parent task segments sent
          INDX_MAX_V%EAST=MAX(INDX_MAX_V%EAST,PARENT_INFO(3,N))            !<-- Ending child J for union of parent task segments sent
        ENDDO
      ENDIF
!
      NUM_PARENT_TASKS_SENDING_V%EAST=KOUNT
!!!   LENGTH_BND_SEG_V%EAST=INDX_MAX_V%EAST-INDX_MIN_V%EAST+1
!
      east_v: IF(NUM_PARENT_TASKS_SENDING_V%EAST>0)THEN                    !<-- Does this child task recv Eboundary V data from parent?
!
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            ALLOCATE(cc%MY_BC_VARS_V_E%VAR_2D(NV)%SIDE(1:N_BLEND_V,INDX_MIN_V%EAST:INDX_MAX_V%EAST)) !<-- 2-D vbls on this child task's
                                                                                                     !    east V bndry segment.
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            ALLOCATE(cc%MY_BC_VARS_V_E%VAR_3D(NV)%SIDE(1:N_BLEND_V,INDX_MIN_V%EAST:INDX_MAX_V%EAST,1:LM)) !<-- 3-D vbls on this child task's
                                                                                                          !    east V bndry segment.
          ENDDO
        ENDIF
!
        ILIM_LO=1
        ILIM_HI=N_BLEND_V
        JLIM_LO=INDX_MIN_V%EAST
        JLIM_HI=INDX_MAX_V%EAST
!
        LENGTH=NLEV_V*(ILIM_HI-ILIM_LO+1)*(JLIM_HI-JLIM_LO+1)              !<-- All V-pt BC variables are assumed to be 3-D
        ALLOCATE(cc%BOUND_1D_EAST_V(1:LENGTH),stat=ISTAT)                  !<-- 1-D combined V-point data on child task's Ebndry segment
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_LO_EAST_V'                   &  !<-- Name of the boundary array's lower I limit
                              ,value=ILIM_LO                            &  !<-- The boundary array's lower I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper I Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='ILIM_HI_EAST_V'                   &  !<-- Name of the boundary array's upper I limit
                              ,value=ILIM_HI                            &  !<-- The boundary array's upper I limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Lower J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_LO_EAST_V'                   &  !<-- Name of the boundary array's lower J limit
                              ,value=JLIM_LO                            &  !<-- The boundary array's lower J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry V Data Upper J Limit"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=EXP_STATE                          &  !<-- The Parent_Child Coupler export state
                              ,name ='JLIM_HI_EAST_V'                   &  !<-- Name of the boundary array's upper J limit
                              ,value=JLIM_HI                            &  !<-- The boundary array's upper J limit
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_LIMITS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      ENDIF east_v
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHILD_RECVS_CHILD_DATA_LIMITS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE CHILD_SENDS_TOPO_TO_PARENT(MY_DOMAIN_ID                &
                                           ,IMP_STATE )
!
!-----------------------------------------------------------------------
!***  The children send their boundary surface geopotential to their 
!***  parents so the parents can properly balance their own data that 
!***  they interpolate to child boundary gridpoints. 
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: MY_DOMAIN_ID                        !<-- This child's domain ID
!
      TYPE(ESMF_State),INTENT(IN) :: IMP_STATE                             !<-- Parent-Child Coupler import state
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: IERR,KOUNT,MYPE                             &
                           ,N,N1,N2,NTAG_SEND,NUM_WORDS                 &
                           ,RC,RC_FIS
!
      INTEGER(kind=KINT) :: I_LO,I_HI,I_OFFSET                          &
                           ,J_LO,J_HI,J_OFFSET
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: STATUS
!
      REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: FIS_SEND
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!     I_OFFSET=IMS-1+NHALO                                                 !<-- Offset of I in unloaded FIS vs. original FIS
!     J_OFFSET=JMS-1+NHALO                                                 !<-- Offset of J in unloaded FIS vs. original FIS
      I_OFFSET=0                                                           !<-- ESMF_INDEX now GLOBAL
      J_OFFSET=0                                                           !<-- ESMF_INDEX now GLOBAL
!
!-----------------------------------------------------------------------
!***  Extract the Sfc Geopotential from the Coupler's import state.
!***  If this child domain is also a parent then it already extracted
!***  its FIS in 'parent_block' of PARENT_CHILD_CPL_INITIALIZE but we
!***  now extract FIS again in case this child domain is not a parent.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract FIS Field from Parent-Child Coupler Import State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state   =IMP_STATE                             &  !<-- The parent-child coupler import state
                        ,itemName='FIS'                                 &  !<-- Extract FIS Field
                        ,field   =HOLD_FIELD                            &  !<-- Put the extracted Field here
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FIS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract FIS from ESMF Field in Parent-Child Coupler"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldGet(field    =HOLD_FIELD                           &  !<-- Field that holds the data pointer
                        ,localDe  =0                                    &
                        ,farrayPtr=FIS                                  &  !<-- Put the pointer here
                        ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_FIS)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      CALL MPI_COMM_RANK(COMM_TO_MY_PARENT,MYPE,IERR)                      !<-- Obtain rank of this child task
!
!-----------------------------------------------------------------------
!
!------------------------------
!***  Child South Boundary FIS
!------------------------------
!
!     write(0,*)' CHILD_SENDS_TOPO_TO_PARENT mype=',mype,' NUM_PARENT_TASKS_SENDING_H%SOUTH=',NUM_PARENT_TASKS_SENDING_H%SOUTH
      IF(NUM_PARENT_TASKS_SENDING_H%SOUTH>0)THEN                           !<-- Child tasks know which parent tasks compute their BCs
        NTAG_SEND=MYPE+1000*MY_DOMAIN_ID                                   !<-- A unique MPI tag for this Send
!
        DO N=1,NUM_PARENT_TASKS_SENDING_H%SOUTH                            !<-- Child sends its FIS to parent tasks that will be
!                                                                               computing its BCs.
          I_LO=PARENT_TASK(N)%SOUTH_H%INDX_START                           !<-- Starting I of child covered by parent task N
          I_HI=PARENT_TASK(N)%SOUTH_H%INDX_END_EXP                         !<-- Ending I of child for expanded area covered by parent task N
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H+1)                            !<-- # of child points covered by parent task N
          ALLOCATE(FIS_SEND(1:NUM_WORDS))                                  !<-- Array to hold child FIS values to go to parent task N
                                                                           !    with extra row of values for 4-pt interp to V pts
          KOUNT=0
!
          DO N2=1,N_BLEND_H+1                                              !<-- Extra row for 4-pt interp of PD to V pts
          DO N1=I_LO,I_HI
            KOUNT=KOUNT+1
            FIS_SEND(KOUNT)=FIS(N1-I_OFFSET,N2-J_OFFSET)                   !<-- 1-D FIS of child points covered by parent task N
            IF(ABS(FIS_SEND(KOUNT))<1.E-2)THEN
              FIS_SEND(KOUNT)=0.
            ENDIF
          ENDDO
          ENDDO
!
          CALL MPI_SEND(FIS_SEND                                        &  !<-- Send FIS data to parent task N
                       ,NUM_WORDS                                       &  !<-- There are NUM_WORDS words in the data
                       ,MPI_REAL                                        &  !<-- Data is type Real
                       ,PARENT_TASK(N)%SOUTH_H%ID_SOURCE                &  !<-- Data sent to this parent task
!                      ,MYPE                                            &  !<-- Use child task ID as the tag
                       ,NTAG_SEND                                       &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between this child and its parent
                       ,IERR)
!
          DEALLOCATE(FIS_SEND)
!
        ENDDO
!
      ENDIF
!
!------------------------------
!***  Child North Boundary FIS
!------------------------------
!
      IF(NUM_PARENT_TASKS_SENDING_H%NORTH>0)THEN                           !<-- Child tasks know which parent tasks compute their BCs
        NTAG_SEND=MYPE+2000*MY_DOMAIN_ID                                   !<-- A unique MPI tag for this Send
!                                                                               
        DO N=1,NUM_PARENT_TASKS_SENDING_H%NORTH                            !<-- Child sends its FIS to parent tasks that will be
!                                                                               computing its BCs.
          I_LO=PARENT_TASK(N)%NORTH_H%INDX_START                           !<-- Starting I of child covered by parent task N
          I_HI=PARENT_TASK(N)%NORTH_H%INDX_END_EXP                         !<-- Ending I of child for expanded area covered by parent task N
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H+1)                            !<-- # of child points covered by parent task N
          ALLOCATE(FIS_SEND(1:NUM_WORDS))                                  !<-- Array to hold child FIS values to go to parent task N
                                                                           !    with extra row of values for 4-pt interp to V pts
          KOUNT=0
!
          DO N2=JTE-N_BLEND_H  ,JTE                                        !<-- Extra row for 4-pt interp of PD to V pts
          DO N1=I_LO,I_HI
            KOUNT=KOUNT+1
            FIS_SEND(KOUNT)=FIS(N1-I_OFFSET,N2-J_OFFSET)                   !<-- 1-D FIS of child points covered by parent task N
            IF(ABS(FIS_SEND(KOUNT))<1.E-2)THEN
              FIS_SEND(KOUNT)=0.
            ENDIF
          ENDDO
          ENDDO
!
          CALL MPI_SEND(FIS_SEND                                        &  !<-- Send FIS data to parent task N
                       ,NUM_WORDS                                       &  !<-- There are NUM_WORDS words in the data
                       ,MPI_REAL                                        &  !<-- Data is type Real
                       ,PARENT_TASK(N)%NORTH_H%ID_SOURCE                &  !<-- Data sent to this parent task
!                      ,MYPE                                            &  !<-- Use child task ID as the tag
                       ,NTAG_SEND                                       &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between this child and its parent
                       ,IERR)
!
          DEALLOCATE(FIS_SEND)
        ENDDO
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------
!***  Child West Boundary FIS
!-----------------------------
!
      IF(NUM_PARENT_TASKS_SENDING_H%WEST>0)THEN                            !<-- Child tasks know which parent tasks compute their BCs
        NTAG_SEND=MYPE+3000*MY_DOMAIN_ID                                   !<-- A unique MPI tag for this Send
!                                                                          
        DO N=1,NUM_PARENT_TASKS_SENDING_H%WEST                             !<-- Child sends its FIS to parent tasks that will be
!                                                                               computing its BCs.
          J_LO=PARENT_TASK(N)%WEST_H%INDX_START                            !<-- Starting J of child covered by parent task N
          J_HI=PARENT_TASK(N)%WEST_H%INDX_END_EXP                          !<-- Ending J of child for expanded area covered by parent task N
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H+1)                            !<-- # of child points covered by parent task N
          ALLOCATE(FIS_SEND(1:NUM_WORDS))                                  !<-- Array to hold child FIS values to go to parent task N
                                                                           !    with extra row of values for 4-pt interp to V pts
          KOUNT=0
!
          DO N2=J_LO,J_HI
          DO N1=1,N_BLEND_H+1                                              !<-- Extra row for 4-pt interp of PD to V pts
            KOUNT=KOUNT+1
            FIS_SEND(KOUNT)=FIS(N1-I_OFFSET,N2-J_OFFSET)                   !<-- 1-D FIS of child points covered by parent task N
            IF(ABS(FIS_SEND(KOUNT))<1.E-2)then
              FIS_SEND(KOUNT)=0.
            ENDIF
          ENDDO
          ENDDO
!
          CALL MPI_SEND(FIS_SEND                                        &  !<-- Send FIS data to parent task N
                       ,NUM_WORDS                                       &  !<-- There are NUM_WORDS words in the data
                       ,MPI_REAL                                        &  !<-- Data is type Real
                       ,PARENT_TASK(N)%WEST_H%ID_SOURCE                 &  !<-- Data sent to this parent task
!                      ,MYPE                                            &  !<-- Use child task ID as the tag
                       ,NTAG_SEND                                       &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between this child and its parent
                       ,IERR)
!
          DEALLOCATE(FIS_SEND)
        ENDDO
!
      ENDIF
!
!-----------------------------
!***  Child East Boundary FIS
!-----------------------------
!
      IF(NUM_PARENT_TASKS_SENDING_H%EAST>0)THEN                            !<-- Child tasks know which parent tasks compute their BCs
        NTAG_SEND=MYPE+4000*MY_DOMAIN_ID                                   !<-- A unique MPI tag for this Send
!
        DO N=1,NUM_PARENT_TASKS_SENDING_H%EAST                             !<-- Child sends its FIS to parent tasks that will be
!                                                                               computing its BCs.
          J_LO=PARENT_TASK(N)%EAST_H%INDX_START                            !<-- Starting J of child covered by parent task N
          J_HI=PARENT_TASK(N)%EAST_H%INDX_END_EXP                          !<-- Ending J of child for expanded area covered by parent task N
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H+1)                            !<-- # of child points covered by parent task N
          ALLOCATE(FIS_SEND(1:NUM_WORDS))                                  !<-- Array to hold child FIS values to go to parent task N
                                                                           !    with extra row of values for 4-pt interp to V pts
          KOUNT=0
!
          DO N2=J_LO,J_HI
          DO N1=ITE-N_BLEND_H  ,ITE                                        !<-- Extra row for 4-pt interp of PD to V pts
            KOUNT=KOUNT+1
            FIS_SEND(KOUNT)=FIS(N1-I_OFFSET,N2-J_OFFSET)                   !<-- 1-D FIS of child points covered by parent task N
            IF(ABS(FIS_SEND(KOUNT))<1.E-2)THEN
              FIS_SEND(KOUNT)=0.
            ENDIF
          ENDDO
          ENDDO
!
          CALL MPI_SEND(FIS_SEND                                        &  !<-- Send FIS data to parent task N
                       ,NUM_WORDS                                       &  !<-- There are NUM_WORDS words in the data
                       ,MPI_REAL                                        &  !<-- Data is type Real
                       ,PARENT_TASK(N)%EAST_H%ID_SOURCE                 &  !<-- Data sent to this parent task
!                      ,MYPE                                            &  !<-- Use child task ID as the tag
                       ,NTAG_SEND                                       &  !<-- MPI tag
                       ,COMM_TO_MY_PARENT                               &  !<-- MPI intracommunicator between this child and its parent
                       ,IERR)
!
          DEALLOCATE(FIS_SEND)
        ENDDO
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHILD_SENDS_TOPO_TO_PARENT
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_RECVS_CHILD_TOPO(N_CHILD,MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Parents receive the boundary topography from their children
!***  so the parents can properly balance their own data that they
!***  interpolate to child gridpoints.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &  !<-- The child who is sending
                                      ,MY_DOMAIN_ID                        !<-- The parent's domain ID
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: CHILDTASK,ID,IERR,N,NDATA,NRANK             &
                           ,NTAG_RECV,NTX,NUM_WORDS
!
      INTEGER(kind=KINT) :: I_LO,I_HI,J_LO,J_HI
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: STATUS
!
      TYPE(COMPOSITE),POINTER :: CC
!
      integer(kind=kint) :: nnnn
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      N=N_CHILD
      ID=MY_DOMAIN_ID
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  The parent tasks receive sfc geopotentials from the
!***  child boundary tasks.
!-----------------------------------------------------------------------
!
!------------------------------
!***  Child South Boundary FIS
!------------------------------
!
      NUM_TASKS_SEND_H_S=>cc%NUM_TASKS_SEND_H_S
      FIS_CHILD_SOUTH=>cc%FIS_CHILD_SOUTH
!
      IF(NUM_TASKS_SEND_H_S(N)>0)THEN                                      !<-- This parent task covers some child Sboundary H points
!
        NDATA=NUM_TASKS_SEND_H_S(N)
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1:NDATA))                        !<-- FIS data slot for each Sbndry child task on parent task
!     write(0,*)' PARENT_RECVS_CHILD_TOPO allocated fis_child_south(',n,')%tasks(1:',ndata,')'
        ALLOCATE(HANDLE_CHILD_TOPO_S(ID)%CHILDREN(N)%DATA(NDATA))          !<-- Request handles for IRecv
!
        DO NTX=1,NUM_TASKS_SEND_H_S(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          I_LO=CHILDTASK_H_SAVE(N)%I_LO_SOUTH(NTX)                         !<-- Starting I of child point bndry segment on this parent task
          I_HI=CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NTX)                         !<-- Ending I of child point bndry segment on this parent task
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H_CHILD(N)+1)                   !<-- # of child points in its bndry segment on parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NTX,1)                    !<-- Count of child task in list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Rank of child task NTX in p-c intracommunicator
          NTAG_RECV=CHILDTASK_BNDRY_H_RANKS(N)%SOUTH(NTX,2)             &  !<-- A unique MPI tag for this Recv
                   +1000*MY_CHILDREN_ID(N)             
!
          ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(NTX)%DATA(1:NUM_WORDS))        !<-- FIS on child S bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
!     write(0,*)' PARENT_RECVS_CHILD_TOPO allocated fis_child_south(',n,')%tasks(',ntx,')%data(1:',num_words,')'
!     write(0,*)' before IRecv S topo from child #',n,' child task #',ntx,' child task rank=',childtask,' ntag=',ntag_recv &
!              ,' num_words=',num_words
!     write(0,*)' i_lo=',i_lo,' i_hi=',i_hi,' n_blend_h_child(n)=',n_blend_h_child(n)
!
          CALL MPI_IRECV(FIS_CHILD_SOUTH(N)%TASKS(NTX)%DATA             &  !<-- Recv FIS values from Sbndry child task NTX
                        ,NUM_WORDS                                      &  !<-- # of FIS values
                        ,MPI_REAL                                       &  !<-- Datatype
                        ,CHILDTASK                                      &  !<-- The child task sending
                        ,NTAG_RECV                                      &  !<-- MPI tag
                        ,COMM_TO_MY_CHILDREN(N)                         &  !<-- MPI intracommunicator with child N
                        ,HANDLE_CHILD_TOPO_S(ID)%CHILDREN(N)%DATA(NTX)  &  !<-- MPI request handle for IRecvs
                        ,IERR)
!     write(0,*)' after IRecv S topo from child #',n,' child task #',ntx,' child task rank=',childtask,' ntag=',ntag_recv 
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!------------------------------
!***  Child North Boundary FIS
!------------------------------
!
      NUM_TASKS_SEND_H_N=>cc%NUM_TASKS_SEND_H_N
      FIS_CHILD_NORTH=>cc%FIS_CHILD_NORTH
!
      IF(NUM_TASKS_SEND_H_N(N)>0)THEN                                      !<-- This parent task covers some child Nboundary H points
!
        NDATA=NUM_TASKS_SEND_H_N(N)
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1:NDATA))                        !<-- FIS data slot for each Nbndry child task on parent task
        ALLOCATE(HANDLE_CHILD_TOPO_N(ID)%CHILDREN(N)%DATA(NDATA))          !<-- Request handles for IRecv
!
        DO NTX=1,NUM_TASKS_SEND_H_N(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          I_LO=CHILDTASK_H_SAVE(N)%I_LO_NORTH(NTX)                         !<-- Starting I of child point bndry segment on this parent task
          I_HI=CHILDTASK_H_SAVE(N)%I_HI_NORTH(NTX)                         !<-- Ending I of child point bndry segment on this parent task
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H_CHILD(N)+1)                   !<-- # of child points in its bndry segment on parent task
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NTX,1)                    !<-- Count of child task in list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Rank of child task NTX in p-c intracommunicator
          NTAG_RECV=CHILDTASK_BNDRY_H_RANKS(N)%NORTH(NTX,2)             &  !<-- A unique MPI tag for this Recv
                   +2000*MY_CHILDREN_ID(N)             
!
          ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(NTX)%DATA(1:NUM_WORDS))        !<-- FIS on child N bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
!
          CALL MPI_IRECV(FIS_CHILD_NORTH(N)%TASKS(NTX)%DATA             &  !<-- Recv FIS values from Nbndry child task NTX
                        ,NUM_WORDS                                      &  !<-- # of FIS values
                        ,MPI_REAL                                       &  !<-- Datatype
                        ,CHILDTASK                                      &  !<-- The child task sending
                        ,NTAG_RECV                                      &  !<-- MPI tag
                        ,COMM_TO_MY_CHILDREN(N)                         &  !<-- MPI intracommunicator with child N
                        ,HANDLE_CHILD_TOPO_N(ID)%CHILDREN(N)%DATA(NTX)  &  !<-- MPI request handles for IRecvs
                        ,IERR)
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------
!***  Child West Boundary FIS
!-----------------------------
!
      NUM_TASKS_SEND_H_W=>cc%NUM_TASKS_SEND_H_W
      FIS_CHILD_WEST=>cc%FIS_CHILD_WEST
!
      IF(NUM_TASKS_SEND_H_W(N)>0)THEN                                      !<-- This parent task covers some child Wboundary H points
!
        NDATA=NUM_TASKS_SEND_H_W(N)
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1:NDATA))                         !<-- FIS data slot for each Wbndry child task on parent task
        ALLOCATE(HANDLE_CHILD_TOPO_W(ID)%CHILDREN(N)%DATA(NDATA))          !<-- Request handles for IRecv
!
        DO NTX=1,NUM_TASKS_SEND_H_W(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          J_LO=CHILDTASK_H_SAVE(N)%J_LO_WEST(NTX)                          !<-- Starting J of child point bndry segment on this parent task
          J_HI=CHILDTASK_H_SAVE(N)%J_HI_WEST(NTX)                          !<-- Ending J of child point bndry segment on this parent task
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H_CHILD(N)+1)                   !<-- # of child points in its bndry segment on parent task
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NTX,1)                     !<-- Count of child task in list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Rank of child task NTX in p-c intracommunicator
          NTAG_RECV=CHILDTASK_BNDRY_H_RANKS(N)%WEST(NTX,2)              &  !<-- A unique MPI tag for this Recv
                   +3000*MY_CHILDREN_ID(N)             
!
          ALLOCATE(FIS_CHILD_WEST(N)%TASKS(NTX)%DATA(1:NUM_WORDS))         !<-- FIS on child W bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          CALL MPI_IRECV(FIS_CHILD_WEST(N)%TASKS(NTX)%DATA              &  !<-- Recv FIS values from Wbndry child task NTX
                        ,NUM_WORDS                                      &  !<-- # of FIS values
                        ,MPI_REAL                                       &  !<-- Datatype
                        ,CHILDTASK                                      &  !<-- The child task sending
                        ,NTAG_RECV                                      &  !<-- MPI tag
                        ,COMM_TO_MY_CHILDREN(N)                         &  !<-- MPI intracommunicator with child N
                        ,HANDLE_CHILD_TOPO_W(ID)%CHILDREN(N)%DATA(NTX)  &  !<-- MPI request handles for IRecvs
                        ,IERR)
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------
!***  Child East Boundary FIS
!-----------------------------
!
      NUM_TASKS_SEND_H_E=>cc%NUM_TASKS_SEND_H_E
      FIS_CHILD_EAST=>cc%FIS_CHILD_EAST
!
      IF(NUM_TASKS_SEND_H_E(N)>0)THEN                                      !<-- This parent task covers some child Eboundary H points
!
        NDATA=NUM_TASKS_SEND_H_E(N)
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1:NDATA))                         !<-- FIS data slot for each Ebndry child task on parent task
        ALLOCATE(HANDLE_CHILD_TOPO_E(ID)%CHILDREN(N)%DATA(NDATA))          !<-- Request handles for IRecv
!
        DO NTX=1,NUM_TASKS_SEND_H_E(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          J_LO=CHILDTASK_H_SAVE(N)%J_LO_EAST(NTX)                          !<-- Starting J of child point bndry segment on this parent task
          J_HI=CHILDTASK_H_SAVE(N)%J_HI_EAST(NTX)                          !<-- Ending J of child point bndry segment on this parent task
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H_CHILD(N)+1)                   !<-- # of child points in its bndry segment on parent task
          NRANK=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NTX,1)                     !<-- Count of child task in list of fcst tasks
          CHILDTASK=child_ranks(MY_DOMAIN_ID)%CHILDREN(N)%DATA(NRANK-1)    !<-- Rank of child task NTX in p-c intracommunicator
          NTAG_RECV=CHILDTASK_BNDRY_H_RANKS(N)%EAST(NTX,2)              &  !<-- A unique MPI tag for this Recv
                   +4000*MY_CHILDREN_ID(N)                 
!
          ALLOCATE(FIS_CHILD_EAST(N)%TASKS(NTX)%DATA(1:NUM_WORDS))         !<-- FIS on child E bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
!     write(0,*)' PARENT_RECVS_CHILD_TOPO allocated FIS_CHILD_EAST(',n,')%tasks(',ntx,')%data(1:',num_words,')'
!     write(0,*)' j_lo=',j_lo,' j_hi=',j_hi,' n_blend_h_child(',n,')=',n_blend_h_child(n)
!
!     write(0,*)' before IRecv E topo from child #',n,' child task #',ntx,' child task rank=',childtask,' ntag=',ntag_recv 
          CALL MPI_IRECV(FIS_CHILD_EAST(N)%TASKS(NTX)%DATA              &  !<-- Recv FIS values from Ebndry child task NTX
                        ,NUM_WORDS                                      &  !<-- # of FIS values
                        ,MPI_REAL                                       &  !<-- Datatype
                        ,CHILDTASK                                      &  !<-- The child task sending
                        ,NTAG_RECV                                      &  !<-- MPI tag
                        ,COMM_TO_MY_CHILDREN(N)                         &  !<-- MPI intracommunicator with child N
                        ,HANDLE_CHILD_TOPO_E(ID)%CHILDREN(N)%DATA(NTX)  &  !<-- MPI request handle for the IRecv
                        ,IERR)
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_RECVS_CHILD_TOPO
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_COMPUTES_CHILD_TOPO(N_CHILD                     &
                                           ,I_PARENT_SW                 &
                                           ,J_PARENT_SW                 &
                                           ,IM_CHILD                    &
                                           ,JM_CHILD                    &
                                           ,N_BLEND_H_CHILD             &
                                           ,LBND1,UBND1,LBND2,UBND2     &
                                           ,MOVING_NEST_TOPO            &
                                             )
!
!-----------------------------------------------------------------------
!***  Parents fill the working arrays of their moving children's
!***  boundary topography.  The parents carry full arrays of topography
!***  at each of their moving children's resolutions so the data only
!***  needs to be lifted from those arrays.  This avoids Sends and
!***  Recvs of that data which could force the parents to Wait. 
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N_CHILD                          &  !<-- Which child are we considering?
                                      ,I_PARENT_SW                      &  !<-- Parent I index of child's SW corner 
                                      ,J_PARENT_SW                      &  !<-- Parent J index of child's SW corner 
                                      ,IM_CHILD                         &  !<-- I dimension of child domain
                                      ,JM_CHILD                         &  !<-- J dimension of child domain
                                      ,N_BLEND_H_CHILD                  &  !<-- Width of child's boundary blending region
!
                                      ,LBND1,UBND1                      &  !<-- I limits of nest-res FIS on this parent task
                                      ,LBND2,UBND2                         !<-- J limits of nest-res FIS on this parent task
!
      REAL(kind=KFPT),DIMENSION(LBND1:UBND1,LBND2:UBND2),INTENT(IN) ::  &
                                                      MOVING_NEST_TOPO     !<-- Nest-resolution topography on the parent task
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,I_HI,I_LO,I_OFFSET,ISTART                 &
                           ,J,J_HI,J_LO,J_OFFSET,JSTART                 &
                           ,KOUNT,N,NTX,NUM_WORDS
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: FIS_X
!
      integer(kind=kint) :: nnnn
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      N=N_CHILD
!
      ISTART=MAX(IMS,IDS)                                                  !<-- The SW corner of this parent domain
      JSTART=MAX(JMS,JDS)                                                  !<--
!
!------------------------------
!***  Child South Boundary FIS
!------------------------------
!
      IF(NUM_TASKS_SEND_H_S(N)>0)THEN                                      !<-- This parent task covers some child Sboundary H points
!
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1:NUM_TASKS_SEND_H_S(N)))        !<-- FIS data slot for each Sbndry child task on parent task
!
        DO NTX=1,NUM_TASKS_SEND_H_S(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          I_LO=CHILDTASK_H_SAVE(N)%I_LO_SOUTH(NTX)                         !<-- Starting I of child point bndry segment on this parent task
          I_HI=CHILDTASK_H_SAVE(N)%I_HI_SOUTH(NTX)                         !<-- Ending I of child point bndry segment on this parent task
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H_CHILD+1)                      !<-- # of child points in its bndry segment on parent task
!
          ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(NTX)%DATA(1:NUM_WORDS))        !<-- FIS on child S bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          FIS_X=>FIS_CHILD_SOUTH(N)%TASKS(NTX)%DATA
!
          I_OFFSET=(I_PARENT_SW-ISTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- I offset of child SW corner in full topo array on parent
                   +LBND1-1                                         
          J_OFFSET=(J_PARENT_SW-JSTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- J offset of child SW corner in full topo array on parent
                   +LBND2-1
          KOUNT=0
!
          DO J=1,N_BLEND_H_CHILD+1
          DO I=I_LO,I_HI
            KOUNT=KOUNT+1
            FIS_X(KOUNT)=MOVING_NEST_TOPO(I+I_OFFSET,J+J_OFFSET)           !<-- Lift child topography from full parent array
          ENDDO
          ENDDO
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!------------------------------
!***  Child North Boundary FIS
!------------------------------
!
      IF(NUM_TASKS_SEND_H_N(N)>0)THEN                                      !<-- This parent task covers some child Nboundary H points
!
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1:NUM_TASKS_SEND_H_N(N)))        !<-- FIS data slot for each Nbndry child task on parent task
!
        DO NTX=1,NUM_TASKS_SEND_H_N(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          I_LO=CHILDTASK_H_SAVE(N)%I_LO_NORTH(NTX)                         !<-- Starting I of child point bndry segment on this parent task
          I_HI=CHILDTASK_H_SAVE(N)%I_HI_NORTH(NTX)                         !<-- Ending I of child point bndry segment on this parent task
          NUM_WORDS=(I_HI-I_LO+1)*(N_BLEND_H_CHILD+1)                      !<-- # of child points in its bndry segment on parent task
!
          ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(NTX)%DATA(1:NUM_WORDS))        !<-- FIS on child N bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          FIS_X=>FIS_CHILD_NORTH(N)%TASKS(NTX)%DATA
!
          I_OFFSET=(I_PARENT_SW-ISTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- I offset of child SW corner in full topo array on parent
                   +LBND1-1                                          
          J_OFFSET=(J_PARENT_SW-JSTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- J offset of child SW corner in full topo array on parent
                   +LBND2-1                                          
          KOUNT=0
!
          DO J=JM_CHILD-N_BLEND_H_CHILD  ,JM_CHILD
          DO I=I_LO,I_HI
            KOUNT=KOUNT+1
            FIS_X(KOUNT)=MOVING_NEST_TOPO(I+I_OFFSET,J+J_OFFSET)           !<-- Lift child topography from full parent array
          ENDDO
          ENDDO
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_NORTH(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------
!***  Child West Boundary FIS
!-----------------------------
!
      IF(NUM_TASKS_SEND_H_W(N)>0)THEN                                      !<-- This parent task covers some child Wboundary H points
!
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1:NUM_TASKS_SEND_H_W(N)))         !<-- FIS data slot for each Wbndry child task on parent task
!
        DO NTX=1,NUM_TASKS_SEND_H_W(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          J_LO=CHILDTASK_H_SAVE(N)%J_LO_WEST(NTX)                          !<-- Starting J of child point bndry segment on this parent task
          J_HI=CHILDTASK_H_SAVE(N)%J_HI_WEST(NTX)                          !<-- Ending J of child point bndry segment on this parent task
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H_CHILD+1)                      !<-- # of child points in its bndry segment on parent task
!
          ALLOCATE(FIS_CHILD_WEST(N)%TASKS(NTX)%DATA(1:NUM_WORDS))         !<-- FIS on child W bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          FIS_X=>FIS_CHILD_WEST(N)%TASKS(NTX)%DATA
!
          I_OFFSET=(I_PARENT_SW-ISTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- I offset of child SW corner in full topo array on parent
                   +LBND1-1                                          
          J_OFFSET=(J_PARENT_SW-JSTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- J offset of child SW corner in full topo array on parent
                   +LBND2-1                                          
          KOUNT=0
!
          DO J=J_LO,J_HI
          DO I=1,N_BLEND_H_CHILD+1
            KOUNT=KOUNT+1
            FIS_X(KOUNT)=MOVING_NEST_TOPO(I+I_OFFSET,J+J_OFFSET)           !<-- Lift child topography from full parent array
          ENDDO
          ENDDO
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_WEST(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!-----------------------------
!***  Child East Boundary FIS
!-----------------------------
!
      IF(NUM_TASKS_SEND_H_E(N)>0)THEN                                      !<-- This parent task covers some child Eboundary H points
!
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1:NUM_TASKS_SEND_H_E(N)))         !<-- FIS data slot for each Ebndry child task on parent task
!
        DO NTX=1,NUM_TASKS_SEND_H_E(N)                                     !<-- Loop through those particular child tasks 
!                                                                          
          J_LO=CHILDTASK_H_SAVE(N)%J_LO_EAST(NTX)                          !<-- Starting J of child point bndry segment on this parent task
          J_HI=CHILDTASK_H_SAVE(N)%J_HI_EAST(NTX)                          !<-- Ending J of child point bndry segment on this parent task
          NUM_WORDS=(J_HI-J_LO+1)*(N_BLEND_H_CHILD+1)                      !<-- # of child points in its bndry segment on parent task
!
          ALLOCATE(FIS_CHILD_EAST(N)%TASKS(NTX)%DATA(1:NUM_WORDS))         !<-- FIS on child E bndry covered by this parent task
                                                                           !    with extra row for 4-pt interpolation of PD to V pts
          FIS_X=>FIS_CHILD_EAST(N)%TASKS(NTX)%DATA
!
          I_OFFSET=(I_PARENT_SW-ISTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- I offset of child SW corner in full topo array on parent
                   +LBND1-1                                          
          J_OFFSET=(J_PARENT_SW-JSTART)*PARENT_CHILD_SPACE_RATIO(N)     &  !<-- J offset of child SW corner in full topo array on parent 
                   +LBND2-1                                          
          KOUNT=0
!
          DO J=J_LO,J_HI
!!!       DO I=IM_CHILD-N_BLEND_H_CHILD+1,IM_CHILD
          DO I=IM_CHILD-N_BLEND_H_CHILD  ,IM_CHILD
            KOUNT=KOUNT+1
            FIS_X(KOUNT)=MOVING_NEST_TOPO(I+I_OFFSET,J+J_OFFSET)           !<-- Lift child topography from full parent array
          ENDDO
          ENDDO
!
        ENDDO
!
      ELSE
!
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1:1))
        ALLOCATE(FIS_CHILD_EAST(N)%TASKS(1)%DATA(1:1))
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_COMPUTES_CHILD_TOPO
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_UPDATE_CHILD_PSFC(FIS,PD,T,Q                    &
                                         ,PT,PDTOP,SG1,SG2              &
                                         ,IMS,IME,JMS,JME               &
                                         ,NLEV                          &
!
                                         ,NUM_CHILD_TASKS               &
                                         ,LIMITS                        &
!
                                         ,FIS_CHILD_SBND                &
                                         ,FIS_CHILD_NBND                &
                                         ,FIS_CHILD_WBND                &
                                         ,FIS_CHILD_EBND                &
!
                                         ,NUM_TASKS_SEND_SBND           &
                                         ,NUM_TASKS_SEND_NBND           &
                                         ,NUM_TASKS_SEND_WBND           &
                                         ,NUM_TASKS_SEND_EBND           &
!
                                         ,I_INDX_PARENT_SBND            &
                                         ,I_INDX_PARENT_NBND            &
                                         ,I_INDX_PARENT_WBND            &
                                         ,I_INDX_PARENT_EBND            &
                                         ,J_INDX_PARENT_SBND            &
                                         ,J_INDX_PARENT_NBND            &
                                         ,J_INDX_PARENT_WBND            &
                                         ,J_INDX_PARENT_EBND            &
!                                                                        
                                         ,I_LO_SOUTH                    &
                                         ,I_HI_SOUTH                    &
                                         ,I_HI_SOUTH_TRANSFER           &
                                         ,I_LO_NORTH                    &
                                         ,I_HI_NORTH                    &
                                         ,I_HI_NORTH_TRANSFER           &
                                         ,J_LO_WEST                     &
                                         ,J_HI_WEST                     &
                                         ,J_HI_WEST_TRANSFER            &
                                         ,J_LO_EAST                     &
                                         ,J_HI_EAST                     &
                                         ,J_HI_EAST_TRANSFER            &
!                                                                        
                                         ,WEIGHT_SBND                   & 
                                         ,WEIGHT_NBND                   & 
                                         ,WEIGHT_WBND                   & 
                                         ,WEIGHT_EBND                   & 
!                                                                                ^
                                         ,N_BLEND                       & !      |
                                         ,IM_CHILD_X                    & !      |
                                         ,JM_CHILD_X                    & !    Input
!                                                                           -----------
                                         ,CHILD_H_SBND                  & !    Output
                                         ,CHILD_H_NBND                  & !      |
                                         ,CHILD_H_WBND                  & !      |
                                         ,CHILD_H_EBND                  & !      v
!
                                         ,PDB_SBND                      & !
                                         ,PDB_NBND                      & !
                                         ,PDB_WBND                      & !
                                         ,PDB_EBND )                      !
!
!-----------------------------------------------------------------------
!***  Given a child's actual surface geopotential, generate a new 
!***  value of PD for the child boundary points based on the 
!***  surrounding parent points.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: IMS,IME,JMS,JME                  &  !<-- Parent task's memory limits
                                      ,IM_CHILD_X,JM_CHILD_X            &  !<-- Index limits of the nest domain
                                      ,N_BLEND                          &  !<-- # of domain boundary blending rows 
                                      ,NLEV                             &  !<-- # of vertical levels in parent array
                                      ,NUM_CHILD_TASKS                  &  !<-- # of fcst tasks on this child
                                      ,NUM_TASKS_SEND_SBND              &  !<-- # of child tasks with Sboundary regions on parent task
                                      ,NUM_TASKS_SEND_NBND              &  !<-- # of child tasks with Nboundary regions on parent task
                                      ,NUM_TASKS_SEND_WBND              &  !<-- # of child tasks with Wboundary regions on parent task
                                      ,NUM_TASKS_SEND_EBND                 !<-- # of child tasks with Eboundary regions on parent task
!
      INTEGER(kind=KINT),DIMENSION(1:4,1:NUM_CHILD_TASKS),INTENT(IN) :: &
                                                                 LIMITS    !<-- ITS,ITE,JTS,JTE on each task of the child
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) ::             &
                                                   I_LO_SOUTH           &  !<-- Starting I of Sbndry region on child tasks
                                                  ,I_HI_SOUTH           &  !<-- Ending I of Sbndry region on child tasks
                                                  ,I_HI_SOUTH_TRANSFER  &  !<-- Ending I of Sbndry region for transfer to child
                                                  ,I_LO_NORTH           &  !<-- Starting I of Nbndry region on child tasks
                                                  ,I_HI_NORTH           &  !<-- Ending I of Nbndry region on child tasks
                                                  ,I_HI_NORTH_TRANSFER  &  !<-- Ending I of Nbndry region for transfer to child
                                                  ,J_LO_WEST            &  !<-- Starting J of Wbndry region on child tasks
                                                  ,J_HI_WEST            &  !<-- Ending J of Wbndry region on child tasks
                                                  ,J_HI_WEST_TRANSFER   &  !<-- Ending J of Wbndry region for transfer to child
                                                  ,J_LO_EAST            &  !<-- Starting J of Ebndry region on child tasks
                                                  ,J_HI_EAST            &  !<-- Ending J of Ebndry region on child tasks
                                                  ,J_HI_EAST_TRANSFER      !<-- Ending J of Ebndry region for transfer to child
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER,INTENT(IN) ::         &
                                                   I_INDX_PARENT_SBND   &  !<-- I indices of parent points west/east of child Sbndry point
                                                  ,I_INDX_PARENT_NBND   &  !<-- I indices of parent points west/east of child Nbndry point
                                                  ,I_INDX_PARENT_WBND   &  !<-- I indices of parent points west/east of child Wbndry point
                                                  ,I_INDX_PARENT_EBND   &  !<-- I indices of parent points west/east of child Ebndry point
                                                  ,J_INDX_PARENT_SBND   &  !<-- J indices of parent points south/north of child Sbndry point
                                                  ,J_INDX_PARENT_NBND   &  !<-- J indices of parent points south/north of child Nbndry point
                                                  ,J_INDX_PARENT_WBND   &  !<-- J indices of parent points south/north of child Wbndry point
                                                  ,J_INDX_PARENT_EBND      !<-- J indices of parent points south/north of child Ebndry point
!
      REAL(kind=KFPT),INTENT(IN) :: PT                                  &  !<-- Top pressure of model domain (Pa)
                                   ,PDTOP                                  !<-- Pressure at top of sigma domain (Pa)
!
      REAL(kind=KFPT),DIMENSION(:),POINTER,INTENT(IN) :: SG1            &  !<-- Interface sigmas, pressure domain
                                                        ,SG2               !<-- Interface sigmas, sigma domain
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS      &  !<-- Parent FIS
                                                              ,PD          !<-- Parent PD
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME,1:NLEV),INTENT(IN) :: T &  !<-- Parent sensible temperature (K)
                                                                     ,Q    !<-- Parent specific humidity (kg/kg)
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER,INTENT(IN) ::            &
                                                          WEIGHT_SBND   &  !<-- Bilinear interp weights of the 4 parent points around 
                                                         ,WEIGHT_NBND   &  !    each point on child's boundary sides (S,N,W,E).
                                                         ,WEIGHT_WBND   &  !    
                                                         ,WEIGHT_EBND      !<--
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(IN) :: FIS_CHILD_SBND &  !<-- Sfc geopot on Sbndry points of each child task
                                                        ,FIS_CHILD_NBND &  !<-- Sfc geopot on Nbndry points of each child task
                                                        ,FIS_CHILD_WBND &  !<-- Sfc geopot on Wbndry points of each child task
                                                        ,FIS_CHILD_EBND    !<-- Sfc geopot on Ebndry points of each child task
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(INOUT) :: CHILD_H_SBND  &  !<-- All H point data for child Sbndry to be sent by parent
                                                           ,CHILD_H_NBND  &  !<-- All H point data for child Nbndry to be sent by parent
                                                           ,CHILD_H_WBND  &  !<-- All H point data for child Wbndry to be sent by parent
                                                           ,CHILD_H_EBND  &  !<-- All H point data for child Ebndry to be sent by parent
!
                                                           ,PDB_SBND      &  !<-- Child boundary PD (Pa) on child domain Sbndry
                                                           ,PDB_NBND      &  !<-- Child boundary PD (Pa) on child domain Nbndry
                                                           ,PDB_WBND      &  !<-- Child boundary PD (Pa) on child domain Wbndry
                                                           ,PDB_EBND         !<-- Child boundary PD (Pa) on child domain Ebndry
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,J,L                                       &
                           ,I_EAST,I_WEST,J_SOUTH,J_NORTH               &
                           ,I_START,I_END,J_START,J_END                 &
                           ,I_START_TRANSFER,I_END_TRANSFER             &
                           ,J_START_TRANSFER,J_END_TRANSFER             &
                           ,KOUNT_PTS                                   &
                           ,KOUNT_TRANSFER                              &
                           ,N_SIDE,NUM_TASKS_SEND,NTX                   &
                           ,RC
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_PARENT_BND  &
                                                    ,J_INDX_PARENT_BND
!
      REAL(kind=KFPT) :: COEFF_1,COEFF_2,D_LNP_DFI,FIS_CHILD            &
                        ,LOG_P1_PARENT,PDTOP_PT,PHI_DIFF,PSFC_CHILD     &
                        ,Q_INTERP,T_INTERP
!
      REAL(kind=KFPT) :: PX_NE,PX_NW,PX_SE,PX_SW                        &
                        ,WGHT_NE,WGHT_NW,WGHT_SE,WGHT_SW
!
      REAL(kind=KFPT),DIMENSION(:,:),ALLOCATABLE :: LOG_PBOT            &
                                                   ,LOG_PTOP
!
      REAL(kind=KFPT),DIMENSION(:,:,:),ALLOCATABLE :: PHI_INTERP        &
                                                     ,PINT_INTERP
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHT_BND
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER :: CHILD_BOUND_H             &
                                             ,FIS_CHILD_BND             &
                                             ,PDB
!
      integer,dimension(8) :: values
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Loop through the four sides of the nest domain boundary (S,N,W,E).
!***  We use some dummy variables/pointers generically for all four
!***  of the sides.
!-----------------------------------------------------------------------
!
      loop_sides: DO N_SIDE=1,4                                              !<-- Loop through the 4 lateral boundaries (S,N,W,E)
!
!-----------------------------------------------------------------------
!
        IF(N_SIDE==1)THEN
          IF(NUM_TASKS_SEND_SBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Sbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_SBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_SBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_SBND
          WEIGHT_BND=>WEIGHT_SBND
          FIS_CHILD_BND=>FIS_CHILD_SBND
          PDB=>PDB_SBND
          CHILD_BOUND_H=>CHILD_H_SBND
!
        ELSEIF(N_SIDE==2)THEN
          IF(NUM_TASKS_SEND_NBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Nbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_NBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_NBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_NBND
          WEIGHT_BND=>WEIGHT_NBND
          FIS_CHILD_BND=>FIS_CHILD_NBND
          PDB=>PDB_NBND
          CHILD_BOUND_H=>CHILD_H_NBND
!
        ELSEIF(N_SIDE==3)THEN
          IF(NUM_TASKS_SEND_WBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Wbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_WBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_WBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_WBND
          WEIGHT_BND=>WEIGHT_WBND
          FIS_CHILD_BND=>FIS_CHILD_WBND
          PDB=>PDB_WBND
          CHILD_BOUND_H=>CHILD_H_WBND
!
        ELSEIF(N_SIDE==4)THEN
          IF(NUM_TASKS_SEND_EBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Ebndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_EBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_EBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_EBND
          WEIGHT_BND=>WEIGHT_EBND
          FIS_CHILD_BND=>FIS_CHILD_EBND
          PDB=>PDB_EBND
          CHILD_BOUND_H=>CHILD_H_EBND
!
        ENDIF
!
!-----------------------------------------------------------------------
!.......................................................................
!$omp parallel do private(                                              &
!$omp         coeff_1,coeff_2,d_lnp_dfi,fis_child,                      &
!$omp         i,i_east,i_end,i_end_transfer,                            &
!$omp         i_start,i_start_transfer,i_west,                          &
!$omp         j,j_end,j_end_transfer,j_north,j_south,                   &
!$omp         j_start,j_start_transfer,                                 &
!$omp         kount_pts,kount_transfer,                                 &
!$omp         l,log_p1_parent,log_pbot,log_ptop,                        &
!$omp         ntx,pdtop_pt,phi_diff,phi_interp,pint_interp,psfc_child,  &
!$omp         px_ne,px_nw,px_se,px_sw,                                  &
!$omp         q_interp,t_interp,wght_ne,wght_nw,wght_se,wght_sw)
!.......................................................................
!
        child_task_loop: DO NTX=1,NUM_TASKS_SEND                            !<-- Fill bndry data for each child task on the child bndry
                                                                            !    segment seen by this parent task.
!-----------------------------------------------------------------------
!
!----------------------------------------------
!***  South boundary limits on this child task
!----------------------------------------------
!
          IF(N_SIDE==1)THEN
            I_START=I_LO_SOUTH(NTX)
            I_END  =I_HI_SOUTH(NTX)
            J_START=1
!           J_END  =N_BLEND
            J_END  =N_BLEND+1                                               !<-- Extend by one row to allow 4-pt averaging of PD to V pts
!
            I_START_TRANSFER=I_START
            I_END_TRANSFER  =I_HI_SOUTH_TRANSFER(NTX)                       !<-- Extra PD points for 4-pt average are not transferred
!
            J_START_TRANSFER=J_START
            J_END_TRANSFER  =J_END-1                                        !<-- The extra row of PD is not transferred to the nests
!
!----------------------------------------------
!***  North boundary limits on this child task
!----------------------------------------------
!
          ELSEIF(N_SIDE==2)THEN
            I_START=I_LO_NORTH(NTX)
            I_END  =I_HI_NORTH(NTX)
!           J_START=JM_CHILD_X-N_BLEND+1
            J_START=JM_CHILD_X-N_BLEND                                      !<-- Extend by one row to allow 4-pt averaging of PD to V pts
            J_END  =JM_CHILD_X
!
            I_START_TRANSFER=I_START
            I_END_TRANSFER  =I_HI_NORTH_TRANSFER(NTX)                       !<-- Extra PD points for 4-pt average are not transferred
!
            J_START_TRANSFER=J_START+1                                      !<-- The extra row of PD is not transferred to the nests
            J_END_TRANSFER  =J_END
!
!---------------------------------------------
!***  West boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==3)THEN
            I_START=1
!           I_END  =N_BLEND
            I_END  =N_BLEND+1                                               !<-- Extend by one row to allow 4-pt averaging of PD to V pts
            J_START=J_LO_WEST(NTX)
            J_END  =J_HI_WEST(NTX)
!
            I_START_TRANSFER=I_START
            I_END_TRANSFER  =I_END-1                                        !<-- The extra row of PD is not transferred to the nests
!
            J_START_TRANSFER=J_START
            J_END_TRANSFER  =J_HI_WEST_TRANSFER(NTX)                        !<-- Extra PD points for 4-pt average are not transferred
!
!---------------------------------------------
!***  East boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==4)THEN
!           I_START=IM_CHILD_X-N_BLEND+1
            I_START=IM_CHILD_X-N_BLEND                                      !<-- Extend by one row to allow 4-pt averaging of PD to V pts
            I_END  =IM_CHILD_X
            J_START=J_LO_EAST(NTX)
            J_END  =J_HI_EAST(NTX)
!
            I_START_TRANSFER=I_START+1                                      !<-- The extra row of PD is not transferred to the nests
            I_END_TRANSFER  =I_END  
!
            J_START_TRANSFER=J_START
            J_END_TRANSFER  =J_HI_EAST_TRANSFER(NTX)                        !<-- Extra PD points for 4-pt average are not transferred
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  Allocate the nest working arrays valid for the current child task
!***  on the child's grid.
!-----------------------------------------------------------------------
!
          ALLOCATE(PINT_INTERP(I_START:I_END,J_START:J_END,1:LM+1))
          ALLOCATE( PHI_INTERP(I_START:I_END,J_START:J_END,1:LM+1))
          ALLOCATE(   LOG_PTOP(I_START:I_END,J_START:J_END))
          ALLOCATE(   LOG_PBOT(I_START:I_END,J_START:J_END))
!
!-----------------------------------------------------------------------
!***  Compute parent heights of layer interfaces at the four points
!***  surrounding each child boundary point.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  First the bottom layer (L=NLEV).
!-----------------------------------------------------------------------
!
          DO J=J_START,J_END                                               !<-- J limits of child task bndry region on parent task
          DO I=I_START,I_END                                               !<-- I limits of child task bndry region on parent task
!
            I_WEST =I_INDX_PARENT_BND(I,J,1)                               !<-- Parent I index on or west of child's boundary point
            I_EAST =I_INDX_PARENT_BND(I,J,2)                               !<-- Parent I index east of child's boundary point
            J_SOUTH=J_INDX_PARENT_BND(I,J,1)                               !<-- Parent J index on or south of child's boundary point
            J_NORTH=J_INDX_PARENT_BND(I,J,2)                               !<-- Parent J index north of child's boundary point
!
            WGHT_SW=WEIGHT_BND(I,J,INDX_SW)                                !<-- Bilinear weight for parent's point SW of nest's point
            WGHT_SE=WEIGHT_BND(I,J,INDX_SE)                                !<-- Bilinear weight for parent's point SE of nest's point
            WGHT_NW=WEIGHT_BND(I,J,INDX_NW)                                !<-- Bilinear weight for parent's point NW of nest's point
            WGHT_NE=WEIGHT_BND(I,J,INDX_NE)                                !<-- Bilinear weight for parent's point NE of nest's point
!
            PX_SW=PD(I_WEST,J_SOUTH)+PT                                    !<-- Sfc pressure on parent point SW of nest point
            PX_SE=PD(I_EAST,J_SOUTH)+PT                                    !<-- Sfc pressure on parent point SE of nest point
            PX_NW=PD(I_WEST,J_NORTH)+PT                                    !<-- Sfc pressure on parent point NW of nest point
            PX_NE=PD(I_EAST,J_NORTH)+PT                                    !<-- Sfc pressure on parent point NE of nest point
!
            PINT_INTERP(I,J,LM+1)=WGHT_SW*PX_SW                         &  !<-- Parent's surface pressure interp'd to this child's 
                                 +WGHT_SE*PX_SE                         &  !    gridpoint (I,J) along child's boundary 
                                 +WGHT_NW*PX_NW                         &  !    on child task NTX.
                                 +WGHT_NE*PX_NE               
!
            LOG_PBOT(I,J)=LOG(PINT_INTERP(I,J,LM+1))                       !<-- Log of parent's horizontally interpolated sfc pressure 
                                                                           !    at child boundary point (I,J)
!
            PHI_INTERP(I,J,LM+1)=WGHT_SW*FIS(I_WEST,J_SOUTH)            &  !<-- Parent sfc geoptential interp'd to nest bndry point (I,J)
                                +WGHT_SE*FIS(I_EAST,J_SOUTH)            &
                                +WGHT_NW*FIS(I_WEST,J_NORTH)            &
                                +WGHT_NE*FIS(I_EAST,J_NORTH)
!
          ENDDO
          ENDDO
!
!-----------------------------------------------------------------------
!***  Now that we have the parent's sfc pressure and sfc geopotential
!***  at the child boundary points (I,J), compute the interface heights
!***  based on the horizontally interpolated interface pressure and
!***  the T and Q.
!-----------------------------------------------------------------------
!
          DO L=NLEV,1,-1                                                   !<-- Work upward to obtain interface geopotentials
!
            PDTOP_PT=PDTOP*SG1(L)+PT
!
            DO J=J_START,J_END                                             !<-- J limits of child task bndry region on parent task
            DO I=I_START,I_END                                             !<-- I limits of child task bndry region on parent task
!
              I_WEST =I_INDX_PARENT_BND(I,J,1)                             !<-- Parent I index on or west of child's boundary point
              I_EAST =I_INDX_PARENT_BND(I,J,2)                             !<-- Parent I index east of child's boundary point
              J_SOUTH=J_INDX_PARENT_BND(I,J,1)                             !<-- Parent J index on or south of child's boundary point
              J_NORTH=J_INDX_PARENT_BND(I,J,2)                             !<-- Parent J index north of child's boundary point
!
              PX_SW=SG2(L)*PD(I_WEST,J_SOUTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point SW of nest point
              PX_SE=SG2(L)*PD(I_EAST,J_SOUTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point SE of nest point
              PX_NW=SG2(L)*PD(I_WEST,J_NORTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point NW of nest point
              PX_NE=SG2(L)*PD(I_EAST,J_NORTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point NE of nest point
!
              WGHT_SW=WEIGHT_BND(I,J,INDX_SW)                              !<-- Bilinear weight for parent's point SW of child's point
              WGHT_SE=WEIGHT_BND(I,J,INDX_SE)                              !<-- Bilinear weight for parent's point SE of child's point
              WGHT_NW=WEIGHT_BND(I,J,INDX_NW)                              !<-- Bilinear weight for parent's point NW of child's point
              WGHT_NE=WEIGHT_BND(I,J,INDX_NE)                              !<-- Bilinear weight for parent's point NE of child's point
!
              PINT_INTERP(I,J,L)=WGHT_SW*PX_SW                          &  !<-- Top interface pressure interp'd to child gridpoint
                                +WGHT_SE*PX_SE                          &  !    along child's boundary for child task NTX
                                +WGHT_NW*PX_NW                          &
                                +WGHT_NE*PX_NE              
!
              T_INTERP=WGHT_SW*T(I_WEST,J_SOUTH,L)                      &  !<-- T interp'd to child gridpoint along child's
                      +WGHT_SE*T(I_EAST,J_SOUTH,L)                      &  !    boundary for child task NTX
                      +WGHT_NW*T(I_WEST,J_NORTH,L)                      &
                      +WGHT_NE*T(I_EAST,J_NORTH,L)
!
              Q_INTERP=WGHT_SW*Q(I_WEST,J_SOUTH,L)                      &  !<-- Q interp'd to child gridpoint along child's
                      +WGHT_SE*Q(I_EAST,J_SOUTH,L)                      &  !    boundary for child task NTX
                      +WGHT_NW*Q(I_WEST,J_NORTH,L)                      &
                      +WGHT_NE*Q(I_EAST,J_NORTH,L)
!
              LOG_PTOP(I,J)=LOG(PINT_INTERP(I,J,L))                        !<-- Log of parent (top) interface pressure at child bndry point
!
              PHI_INTERP(I,J,L)=PHI_INTERP(I,J,L+1)                     &  !<-- Top interface geopotl of parent at child gridpoint (I,J)
                               +R_D*T_INTERP*(1.+P608*Q_INTERP)         &
                               *(LOG_PBOT(I,J)-LOG_PTOP(I,J))
!
              LOG_PBOT(I,J)=LOG_PTOP(I,J)                                  !<--- Move Log(Ptop) to bottom of next model layer up
!
            ENDDO
            ENDDO
!
          ENDDO
!
!-----------------------------------------------------------------------
!***  Use the child's actual sfc geopotential to derive the value of
!***  PD at the child boundary points based on the parent's heights
!***  and pressures at its (the parent's) layer interfaces over the
!***  child's boundary points.
!
!***  If the child's terrain is lower than the value of the parent's
!***  terrain interpolated to the child point then extrapolate the
!***  parent's interpolated Sfc Pressure down to the child's terrain
!***  quadratically.
!-----------------------------------------------------------------------
!
          KOUNT_PTS=0
          KOUNT_TRANSFER=0
!
!-----------------------------------------------------------------------
          core_loop: DO J=J_START,J_END                                    !<-- J limits of child task bndry region on parent task
          DO I=I_START,I_END                                               !<-- I limits of child task bndry region on parent task
!-----------------------------------------------------------------------
!
            KOUNT_PTS=KOUNT_PTS+1
            FIS_CHILD=FIS_CHILD_BND(NTX)%DATA(KOUNT_PTS)
!
            IF(FIS_CHILD<PHI_INTERP(I,J,LM+1))THEN                         !<-- Child's terrain lies below parent's (interp'd to child)
!
              COEFF_1=(PINT_INTERP(I,J,LM+1)-PINT_INTERP(I,J,LM))       &  !<-- Coefficient for linear term
                     /(PHI_INTERP(I,J,LM+1)-PHI_INTERP(I,J,LM))
!
              COEFF_2=(COEFF_1                                          &  !<-- Coefficient for quadratic term
                      -(PINT_INTERP(I,J,LM)-PINT_INTERP(I,J,LM-1))      &  !
                      /(PHI_INTERP(I,J,LM)-PHI_INTERP(I,J,LM-1)))       &  !
                      /(PHI_INTERP(I,J,LM+1)-PHI_INTERP(I,J,LM-1))         !
!
              PHI_DIFF=FIS_CHILD-PHI_INTERP(I,J,LM+1)                      !<-- Diff between nest sfc geopotential and parent's interp'd
!
              PSFC_CHILD=COEFF_2*PHI_DIFF*PHI_DIFF                      &  !<-- Parent pressure at child's boundary terrain surface
                        +COEFF_1*PHI_DIFF                               &
                        +PINT_INTERP(I,J,LM+1)
!
            ELSE                                                           !<-- Child's terrain is at or above parent's
              DO L=LM,1,-1
                IF(FIS_CHILD<PHI_INTERP(I,J,L))THEN
                  LOG_P1_PARENT=LOG(PINT_INTERP(I,J,L+1))                  !<-- Log pressure on bottom of parent model layer
                  D_LNP_DFI=(LOG_P1_PARENT-LOG(PINT_INTERP(I,J,L)))     &  !<-- d[ln(p)]/d[fi] in parent layer L
                           /(PHI_INTERP(I,J,L+1)-PHI_INTERP(I,J,L))
                  PSFC_CHILD=EXP(LOG_P1_PARENT                          &  !<-- Parent pressure at child's boundary terrain surface
                                +D_LNP_DFI*(FIS_CHILD-PHI_INTERP(I,J,L+1)))
                  EXIT
                ENDIF
              ENDDO
            ENDIF
!
            PDB(NTX)%DATA(KOUNT_PTS)=PSFC_CHILD-PT                         !<-- Parent's approximation of child's PD on child's boundary
!
!-----------------------------------------------------------------------
!***  Save only the PD's that are on the nests' boundary region's
!***  mass points into the datastring that will be transferred from
!***  the parent to the nests.  The extra points in the PDB pointer
!***  are for 4-PT averaging onto V points.
!***  Recall that the CHILD_BOUND_* pointer is the 1-D string of all
!***  data sent from parent tasks to child boundary tasks and PDB is
!***  the first data in that string.
!-----------------------------------------------------------------------
!
            IF(I>=I_START_TRANSFER.AND.I<=I_END_TRANSFER                &
                  .AND.                                                 &
               J>=J_START_TRANSFER.AND.J<=J_END_TRANSFER)THEN
!
              KOUNT_TRANSFER=KOUNT_TRANSFER+1
              CHILD_BOUND_H(NTX)%DATA(KOUNT_TRANSFER)=                  &
                        PDB(NTX)%DATA(KOUNT_PTS)
            ENDIF
!
!-----------------------------------------------------------------------
!
          ENDDO
          ENDDO core_loop
!
!-----------------------------------------------------------------------
!
          DEALLOCATE(PINT_INTERP)
          DEALLOCATE(PHI_INTERP)
          DEALLOCATE(LOG_PTOP)  
          DEALLOCATE(LOG_PBOT)  
!
!-----------------------------------------------------------------------
!
       ENDDO child_task_loop
!
!.......................................................................
!$omp end parallel do
!.......................................................................
!
!-----------------------------------------------------------------------
!
      ENDDO loop_sides
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_UPDATE_CHILD_PSFC
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_UPDATE_CHILD_BNDRY(VBL_PARENT                   &
                                          ,VBL_NAME                     &
!
                                          ,PD,PT,PDTOP                  &
                                          ,PSGML1,SGML2,SG1,SG2         &
!
                                          ,PD_SBND                      &
                                          ,PD_NBND                      &
                                          ,PD_WBND                      &
                                          ,PD_EBND                      &
!
                                          ,IMS,IME,JMS,JME              &
                                          ,NLEV                         &
                                          ,N_REMOVE                     &
                                          ,VAR4D_INDX                   &
!
                                          ,NUM_TASKS_SEND_SBND          &
                                          ,NUM_TASKS_SEND_NBND          &
                                          ,NUM_TASKS_SEND_WBND          &
                                          ,NUM_TASKS_SEND_EBND          &
!
                                          ,I_INDX_PARENT_SBND           &
                                          ,I_INDX_PARENT_NBND           &
                                          ,I_INDX_PARENT_WBND           &
                                          ,I_INDX_PARENT_EBND           &
                                          ,J_INDX_PARENT_SBND           &
                                          ,J_INDX_PARENT_NBND           &
                                          ,J_INDX_PARENT_WBND           &
                                          ,J_INDX_PARENT_EBND           &
!                                                                       
                                          ,I_LO_SOUTH                   &
                                          ,I_HI_SOUTH                   &
                                          ,I_HI_SOUTH_TRANSFER          &
                                          ,I_LO_NORTH                   &
                                          ,I_HI_NORTH                   &
                                          ,I_HI_NORTH_TRANSFER          &
                                          ,J_LO_WEST                    &
                                          ,J_HI_WEST                    &
                                          ,J_HI_WEST_TRANSFER           &
                                          ,J_LO_EAST                    &
                                          ,J_HI_EAST                    &
                                          ,J_HI_EAST_TRANSFER           &
!
                                          ,WEIGHT_SBND                  &
                                          ,WEIGHT_NBND                  &
                                          ,WEIGHT_WBND                  &
                                          ,WEIGHT_EBND                  &
!                                                                               ^
                                          ,N_BLEND                      & !     |
                                          ,IM_CHILD_X                   & !     |
                                          ,JM_CHILD_X                   & !   Input
!                                                                           ----------
                                          ,VBL_CHILD_SBND               & !   Output
                                          ,VBL_CHILD_NBND               & !     |
                                          ,VBL_CHILD_WBND               & !     |
                                          ,VBL_CHILD_EBND )               !     v
!
!-----------------------------------------------------------------------
!***  Parent tasks interpolate their values of variables
!***  to child grid points. 
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: IMS,IME,JMS,JME                  &  !<-- Parent task's memory limits
                                      ,IM_CHILD_X,JM_CHILD_X            &  !<-- Index limits of the nest domain
                                      ,N_BLEND                          &  !<-- # of domain boundary blending rows
                                      ,NLEV                             &  !<-- # of vertical levels in parent array
                                      ,N_REMOVE                         &  !<-- # of rows to ignore on north/east sides (H=>0;V=>1)
                                      ,VAR4D_INDX                       &  !<-- Index of 4D dimension (always 1 for 3D var)
!
                                      ,NUM_TASKS_SEND_SBND              &  !<-- # of child tasks with Sbndry points on parent task
                                      ,NUM_TASKS_SEND_NBND              &  !<-- # of child tasks with Nbndry points on parent task
                                      ,NUM_TASKS_SEND_WBND              &  !<-- # of child tasks with Wbndry points on parent task
                                      ,NUM_TASKS_SEND_EBND                 !<-- # of child tasks with Ebndry points on parent task
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) ::             &
                                                 I_LO_SOUTH             &  !<-- Starting I of Sbndry region on child tasks
                                                ,I_HI_SOUTH             &  !<-- Ending I of Sbndry region on child tasks
                                                ,I_HI_SOUTH_TRANSFER    &  !<-- Ending I of Sbndry for transfer to child
                                                ,I_LO_NORTH             &  !<-- Starting I of Nbndry region on child tasks
                                                ,I_HI_NORTH             &  !<-- Ending I of Nbndry region on child tasks
                                                ,I_HI_NORTH_TRANSFER    &  !<-- Ending I of Nbndry for transfer to child
                                                ,J_LO_WEST              &  !<-- Starting J of Wbndry region on child tasks
                                                ,J_HI_WEST              &  !<-- Ending J of Wbndry region on child tasks
                                                ,J_HI_WEST_TRANSFER     &  !<-- Ending J of Wbndry for transfer to child
                                                ,J_LO_EAST              &  !<-- Starting J of Ebndry region on child tasks
                                                ,J_HI_EAST              &  !<-- Ending J of Ebndry region on child tasks
                                                ,J_HI_EAST_TRANSFER        !<-- Ending J of Ebndry for transfer to child
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER,INTENT(IN) ::         &
                                                 I_INDX_PARENT_SBND     &  !<-- I indices of parent points west/east of child Sbndry point
                                                ,I_INDX_PARENT_NBND     &  !<-- I indices of parent points west/east of child Nbndry point
                                                ,I_INDX_PARENT_WBND     &  !<-- I indices of parent points west/east of child Wbndry point
                                                ,I_INDX_PARENT_EBND     &  !<-- I indices of parent points west/east of child Ebndry point
                                                ,J_INDX_PARENT_SBND     &  !<-- J indices of parent points south/north of child Sbndry point
                                                ,J_INDX_PARENT_NBND     &  !<-- J indices of parent points south/north of child Nbndry point
                                                ,J_INDX_PARENT_WBND     &  !<-- J indices of parent points south/north of child Wbndry point
                                                ,J_INDX_PARENT_EBND        !<-- J indices of parent points south/north of child Ebndry point
!
      REAL(kind=KFPT),INTENT(IN) :: PT                                  &  !<-- Top pressure of model domain (Pa)
                                   ,PDTOP                                  !<-- Pressure at top of sigma domain (Pa)
!
      REAL(kind=KFPT),DIMENSION(:),POINTER,INTENT(IN) :: PSGML1         &  !<-- Midlayer pressures, pressure domain
                                                        ,SGML2          &  !<-- Midlayer sigmas, sigma domain
                                                        ,SG1            &  !<-- Interface sigmas, pressure domain
                                                        ,SG2               !<-- Interface sigmas, sigma domain
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PD          !<-- Parent PD
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME,1:NLEV),INTENT(IN) ::   &
                                                           VBL_PARENT      !<-- Current variable on the parent domain
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER,INTENT(IN) ::            &
                                                         WEIGHT_SBND    &  !<-- Bilinear interp weights of the 4 parent points around 
                                                        ,WEIGHT_NBND    &  !    each point on child's boundaries.
                                                        ,WEIGHT_WBND    &  !   
                                                        ,WEIGHT_EBND       !  
!
      CHARACTER(len=*),INTENT(IN) :: VBL_NAME                              !<-- Which variable is the parent interpolating?  Suffix: -nestbc
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(IN) :: PD_SBND        &  !<-- Boundary region PD (Pa) (column mass in sigma domain)
                                                        ,PD_NBND        &  !    on the four sides of the child boundary.
                                                        ,PD_WBND        &  !
                                                        ,PD_EBND           !
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(INOUT) ::             &
                                                         VBL_CHILD_SBND &  !<-- Mass variable in child bndry region as computed
                                                        ,VBL_CHILD_NBND &  !<-- by parent.
                                                        ,VBL_CHILD_WBND &  !
                                                        ,VBL_CHILD_EBND    !
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,J,L                                       &
                           ,I_EAST,I_WEST,J_SOUTH,J_NORTH               &
                           ,I_START,I_START_EXPAND                      &
                           ,I_END,I_END_EXPAND                          &
                           ,J_START,J_START_EXPAND                      &
                           ,J_END,J_END_EXPAND                          &
                           ,KNT_PTS,KNT_PTS_X                           &
                           ,L_VBL,LOC_1,LOC_2                           &
                           ,N_ADD,N_EXP,N_SIDE,N_STRIDE,NTX             &
                           ,NUM_LEVS_SEC,NUM_LEVS_SPLINE                &
                           ,NUM_TASKS_SEND                              &
                           ,RC
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: I_INDX_PARENT_BND  &
                                                    ,J_INDX_PARENT_BND
!
      REAL(kind=KFPT) :: COEFF_1,DELP_EXTRAP,DP1,DP2,DP3,FACTOR         &
                        ,PDTOP_PT,PROD1,PROD2,PROD3,R_DELP
!
      REAL(kind=KFPT) :: PX_NE,PX_NW,PX_SE,PX_SW                        &
                        ,WGHT_NE,WGHT_NW,WGHT_SE,WGHT_SW
!
      REAL(kind=KFPT),DIMENSION(1:LM) :: PMID_CHILD
!
      REAL(kind=KFPT),DIMENSION(1:LM+1) :: P_INPUT                      &
                                          ,SEC_DERIV                    &
                                          ,VBL_INPUT
!
      REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: T_LOWEST                 
!
      REAL(kind=KFPT),DIMENSION(:,:),ALLOCATABLE :: PINT_INTERP_HI      &
                                                   ,PMID_INTERP         &
                                                   ,VBL_INTERP
!
      REAL(kind=KFPT),DIMENSION(:,:,:),ALLOCATABLE :: PINT_INTERP_LO
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: VBL_COL_CHILD
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WEIGHT_BND
!
      LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE :: INVERSION
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER :: PDB                       &
                                             ,VBL_CHILD_BND
!
      integer :: nnn,lll
      integer,dimension(8) :: values
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      N_EXP=1-N_REMOVE                                                     !<-- Handle expansion of PDB range (H->1; V->0)
      NUM_LEVS_SEC=LM+1                                                    !<-- # of levels in spline routine's 2nd derivative array
!
!-----------------------------------------------------------------------
!***  Loop through the four sides of the nest domain boundary (S,N,W,E).
!***  We use some dummy variables/pointers generically for all four
!***  of the sides.
!-----------------------------------------------------------------------
!
      loop_sides: DO N_SIDE=1,4                                            
!
!-----------------------------------------------------------------------
!
        IF(N_SIDE==1)THEN
          IF(NUM_TASKS_SEND_SBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Sbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_SBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_SBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_SBND
          WEIGHT_BND=>WEIGHT_SBND
          PDB=>PD_SBND
          VBL_CHILD_BND=>VBL_CHILD_SBND
!
        ELSEIF(N_SIDE==2)THEN
          IF(NUM_TASKS_SEND_NBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Nbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_NBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_NBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_NBND
          WEIGHT_BND=>WEIGHT_NBND
          PDB=>PD_NBND
          VBL_CHILD_BND=>VBL_CHILD_NBND
!
        ELSEIF(N_SIDE==3)THEN
          IF(NUM_TASKS_SEND_WBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Wbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_WBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_WBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_WBND
          WEIGHT_BND=>WEIGHT_WBND
          PDB=>PD_WBND
          VBL_CHILD_BND=>VBL_CHILD_WBND
!
        ELSEIF(N_SIDE==4)THEN
          IF(NUM_TASKS_SEND_EBND==0)CYCLE                                    !<-- Move on if parent task sees no part of nest's Ebndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_EBND
          I_INDX_PARENT_BND=>I_INDX_PARENT_EBND
          J_INDX_PARENT_BND=>J_INDX_PARENT_EBND
          WEIGHT_BND=>WEIGHT_EBND
          PDB=>PD_EBND
          VBL_CHILD_BND=>VBL_CHILD_EBND
!
        ENDIF
!
!-----------------------------------------------------------------------
!.......................................................................
!$omp parallel do                                                       &
!$omp private(coeff_1,delp_extrap,dp1,dp2,dp3,factor,                   &
!$omp         i,i_east,i_end,i_end_expand,i_start,i_start_expand,       &
!$omp         i_west,inversion,                                         &
!$omp         j,j_end,j_end_expand,j_north,j_south,                     &
!$omp         j_start,j_start_expand,                                   &
!$omp         knt_pts,knt_pts_x,l,l_vbl,loc_1,loc_2,                    &
!$omp         n_add,n_stride,ntx,num_levs_spline,                       &
!$omp         p_input,pdtop_pt,pint_interp_hi,pint_interp_lo,           &
!$omp         pmid_child,pmid_interp,prod1,prod2,prod3,                 &
!$omp         px_ne,px_nw,px_se,px_sw,r_delp,sec_deriv,                 &
!$omp         t_lowest,vbl_col_child,vbl_input,vbl_interp,              &
!$omp         wght_ne,wght_nw,wght_se,wght_sw)
!.......................................................................
!
        child_task_loop: DO NTX=1,NUM_TASKS_SEND                           !<-- Fill bndry data for each child task on the child bndry
                                                                           !    segment seen by this parent task.
!-----------------------------------------------------------------------
!
!----------------------------------------------
!***  South boundary limits on this child task
!----------------------------------------------
!
          IF(N_SIDE==1)THEN
            I_START =I_LO_SOUTH(NTX)
            I_END   =I_HI_SOUTH_TRANSFER(NTX)
            J_START =1
            J_END   =N_BLEND
!
            I_START_EXPAND=I_START                                         !<-- Expanded limits for extra row of PD for 4-pt averaging
            I_END_EXPAND=I_HI_SOUTH(NTX)                                   !
            J_START_EXPAND=J_START                                         !
            J_END_EXPAND=J_END+N_EXP                                       !<--
!
!----------------------------------------------
!***  North boundary limits on this child task
!----------------------------------------------
!
          ELSEIF(N_SIDE==2)THEN
            I_START =I_LO_NORTH(NTX)
            I_END   =I_HI_NORTH_TRANSFER(NTX)
            J_START =JM_CHILD_X-N_BLEND+1-N_REMOVE
            J_END   =JM_CHILD_X-N_REMOVE
!
            I_START_EXPAND=I_START                                         !<-- Expanded limits for extra row of PD for 4-pt averaging
            I_END_EXPAND=I_HI_NORTH(NTX)                                   !
            J_START_EXPAND=J_START-N_EXP                                   !
            J_END_EXPAND=J_END                                             !<--
!
!---------------------------------------------
!***  West boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==3)THEN
            I_START =1
            I_END   =N_BLEND
            J_START =J_LO_WEST(NTX)
            J_END   =J_HI_WEST_TRANSFER(NTX)
!
            I_START_EXPAND=I_START                                         !<-- Expanded limits for extra row of PD for 4-pt averaging
            I_END_EXPAND=I_END+N_EXP                                       !
            J_START_EXPAND=J_START                                         !
            J_END_EXPAND=J_HI_WEST(NTX)                                    !<--
!
!---------------------------------------------
!***  East boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==4)THEN
            I_START =IM_CHILD_X-N_BLEND+1-N_REMOVE
            I_END   =IM_CHILD_X-N_REMOVE
            J_START =J_LO_EAST(NTX)
            J_END   =J_HI_EAST_TRANSFER(NTX)
!
            I_START_EXPAND=I_START-N_EXP                                   !<-- Expanded limits for extra row of PD for 4-pt averaging
            I_END_EXPAND=I_END                                             !
            J_START_EXPAND=J_START                                         !
            J_END_EXPAND=J_HI_EAST(NTX)                                    !<--
!
          ENDIF
!
!-----------------------------------------------------------------------
!
          N_STRIDE=(I_END-I_START+1)*(J_END-J_START+1)                     !<-- # of pts, this side, this child task's bndry region
!
          ALLOCATE(PMID_INTERP(1:N_STRIDE,1:LM))
          ALLOCATE(VBL_INTERP (1:N_STRIDE,1:NLEV))
          ALLOCATE(T_LOWEST   (1:N_STRIDE))
          ALLOCATE(INVERSION  (1:N_STRIDE))
!
          ALLOCATE(PINT_INTERP_HI(I_START:I_END,J_START:J_END))
          ALLOCATE(PINT_INTERP_LO(I_START:I_END,J_START:J_END,1:NLEV+1))
!
!-----------------------------------------------------------------------
!***  We need the mid-layer pressure values in the parent layers
!***  over the child boundary point locations since those are
!***  required for the vertical interpolation of variables
!***  to the mid-layers in the child.
!***  Compute the interface pressures of the parent layers
!***  then take the means to get the mid-layer values.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Start with the bottom layer (L=NLEV).
!-----------------------------------------------------------------------
!
          DO J=J_START,J_END                                               !<-- J limits of child task bndry region on parent task
          DO I=I_START,I_END                                               !<-- I limits of child task bndry region on parent task
!
            I_WEST =I_INDX_PARENT_BND(I,J,1)                               !<-- Parent I index on or west of child's boundary point
            I_EAST =I_INDX_PARENT_BND(I,J,2)                               !<-- Parent I index east of child's boundary point
            J_SOUTH=J_INDX_PARENT_BND(I,J,1)                               !<-- Parent J index on or south of child's boundary point
            J_NORTH=J_INDX_PARENT_BND(I,J,2)                               !<-- Parent J index north of child's boundary point
!
            WGHT_SW=WEIGHT_BND(I,J,INDX_SW)                                !<-- Bilinear weight for parent's point SW of nest's point
            WGHT_SE=WEIGHT_BND(I,J,INDX_SE)                                !<-- Bilinear weight for parent's point SE of nest's point
            WGHT_NW=WEIGHT_BND(I,J,INDX_NW)                                !<-- Bilinear weight for parent's point NW of nest's point
            WGHT_NE=WEIGHT_BND(I,J,INDX_NE)                                !<-- Bilinear weight for parent's point NE of nest's point
!
            PX_SW=PD(I_WEST,J_SOUTH)+PT                                    !<-- Sfc pressure on parent point SW of nest point
            PX_SE=PD(I_EAST,J_SOUTH)+PT                                    !<-- Sfc pressure on parent point SE of nest point
            PX_NW=PD(I_WEST,J_NORTH)+PT                                    !<-- Sfc pressure on parent point NW of nest point
            PX_NE=PD(I_EAST,J_NORTH)+PT                                    !<-- Sfc pressure on parent point NE of nest point
!
            PINT_INTERP_LO(I,J,NLEV+1)=WGHT_SW*PX_SW                    &  !<-- Parent's surface pressure interp'd to this child's
                                      +WGHT_SE*PX_SE                    &  !    gridpoint (I,J) along child's boundary for
                                      +WGHT_NW*PX_NW                    &  !    child task NTX.
                                      +WGHT_NE*PX_NE
!
          ENDDO
          ENDDO
!
!-----------------------------------------------------------------------
!***  Now compute those mid-layer pressures in the parent layers
!***  as well as the values of the parent's variable at those
!***  pressure levels.
!-----------------------------------------------------------------------
!
          DO L=LM,1,-1                                                     !<-- Work upward to get geopotentials on child layer interfaces
!
            KNT_PTS=0
            PDTOP_PT=SG1(L)*PDTOP+PT
!
            IF(NLEV==1)THEN
              L_VBL=1                                                      !<-- Account for possible 2-D boundary variables
            ELSE
              L_VBL=L
            ENDIF
!
            DO J=J_START,J_END                                             !<-- J limits of child task bndry region on parent task
            DO I=I_START,I_END                                             !<-- I limits of child task bndry region on parent task
!
              I_WEST =I_INDX_PARENT_BND(I,J,1)                             !<-- Parent I index on or west of child's boundary point
              I_EAST =I_INDX_PARENT_BND(I,J,2)                             !<-- Parent I index east of child's boundary point
              J_SOUTH=J_INDX_PARENT_BND(I,J,1)                             !<-- Parent J index on or south of child's boundary point
              J_NORTH=J_INDX_PARENT_BND(I,J,2)                             !<-- Parent J index north of child's boundary point
!
              PX_SW=SG2(L)*PD(I_WEST,J_SOUTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point SW of nest point
              PX_SE=SG2(L)*PD(I_EAST,J_SOUTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point SE of nest point
              PX_NW=SG2(L)*PD(I_WEST,J_NORTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point NW of nest point
              PX_NE=SG2(L)*PD(I_EAST,J_NORTH)+PDTOP_PT                     !<-- Pressure, top of layer L, parent point NE of nest point
!
              WGHT_SW=WEIGHT_BND(I,J,INDX_SW)                              !<-- Bilinear weight for parent's point SW of child's point
              WGHT_SE=WEIGHT_BND(I,J,INDX_SE)                              !<-- Bilinear weight for parent's point SE of child's point
              WGHT_NW=WEIGHT_BND(I,J,INDX_NW)                              !<-- Bilinear weight for parent's point NW of child's point
              WGHT_NE=WEIGHT_BND(I,J,INDX_NE)                              !<-- Bilinear weight for parent's point NE of child's point
!
              PINT_INTERP_HI(I,J)=WGHT_SW*PX_SW                         &  !<-- Top interface pressure interp'd to child gridpoint
                                 +WGHT_SE*PX_SE                         &  !    in child's boundary region on child task NTX
                                 +WGHT_NW*PX_NW                         &
                                 +WGHT_NE*PX_NE
!
              KNT_PTS=KNT_PTS+1
!
              PMID_INTERP(KNT_PTS,L)=0.5*(PINT_INTERP_HI(I,J)           &  !<-- Parent midlayer pressure interp'd to child gridpoint
                                         +PINT_INTERP_LO(I,J,L+1))         !    in child's boundary region of child task NTX
!
              VBL_INTERP(KNT_PTS,L_VBL)=WGHT_SW                         &  !<-- Parent variable interp'd to child gridpoint 
                                        *VBL_PARENT(I_WEST,J_SOUTH,L)   &  !    in child's boundary region of child task NTX.
                                       +WGHT_SE                         &  !  
                                        *VBL_PARENT(I_EAST,J_SOUTH,L)   &  !
                                       +WGHT_NW                         &  !  
                                        *VBL_PARENT(I_WEST,J_NORTH,L)   &  !
                                       +WGHT_NE                         &  !
                                        *VBL_PARENT(I_EAST,J_NORTH,L)      !<--
!     if(i==isee.and.j==jsee.and.l==ksee)then
!     if(n_side==2)then
!       write(0,44370)trim(vbl_name)
!       write(0,44371)vbl_interp(knt_pts,l_vbl),knt_pts,i_west,i_east,j_south,j_north
!       write(0,44372)wght_sw,wght_se,wght_nw,wght_ne
!       write(0,44373)vbl_parent(i_west,j_south,l),vbl_parent(i_east,j_south,l) &
!                    ,vbl_parent(i_west,j_north,l),vbl_parent(i_east,j_north,l)
44370   format(' PARENT_UPDATE_CHILD_BNDRY vbl_name=',a)
44371   format(' vbl_interp=',f6.2,' knt_pnts=',i6,' i_west=',i3,' i_east=',i3,' j_south=',i3,' j_north=',i3)
44372   format(' wgts=',4(1x,f6.3))
44373   format(' parent values=',4(1x,f6.2))
!     endif
!     endif
!     if(n_side==3.and.i==5.and.j==7.and.l==1.and.trim(vbl_flag)=='T-nestbc')THEN
!       write(0,33891)knt_pts,vbl_interp(knt_pts,l)
!       write(0,33892)vbl_parent(i_west,j_south,l),vbl_parent(i_east,j_south,l) &
!                    ,vbl_parent(i_west,j_north,l),vbl_parent(i_east,j_north,l)
!       write(0,33893)wght_sw,wght_se,wght_nw,wght_ne
!       write(0,33894)i_west,i_east,j_south,j_north
33891   format(' PARENT_UPDATE_CHILD_BNDRY knt_pts=',i6,' vbl_interp=',z8)
33892   format(' vbl_parent=',4(1x,z8))
33893   format(' wght=',4(1x,z8))
33894   format(' i_west=',i3,' i_east=',i3,' j_south=',i3,' j_north=',i3)
!     endif
              PINT_INTERP_LO(I,J,L)=PINT_INTERP_HI(I,J)
!
            ENDDO
            ENDDO
!
            IF(NLEV==1)EXIT
!
          ENDDO
!
!-----------------------------------------------------------------------
!***  The parent uses mass-weighted averages of the lowest and 
!***  2nd lowest layer temperatures to avoid extrapolation problems
!***  when there is an inversion present.
!-----------------------------------------------------------------------
!
          IF(TRIM(VBL_NAME)=='T-nestbc')THEN
            KNT_PTS=0
!
            DO J=J_START,J_END   
            DO I=I_START,I_END  
              KNT_PTS=KNT_PTS+1
              INVERSION(KNT_PTS)=.FALSE.
              IF(VBL_INTERP(KNT_PTS,NLEV)<VBL_INTERP(KNT_PTS,NLEV-1))THEN
                DP1=PINT_INTERP_LO(I,J,NLEV+1)-PINT_INTERP_LO(I,J,NLEV)
                DP2=PINT_INTERP_LO(I,J,NLEV)-PINT_INTERP_LO(I,J,NLEV-1)
                DP3=PINT_INTERP_LO(I,J,NLEV-1)-PINT_INTERP_LO(I,J,NLEV-2)
 
                PROD1=VBL_INTERP(KNT_PTS,NLEV)*DP1
                PROD2=VBL_INTERP(KNT_PTS,NLEV-1)*DP2
                PROD3=VBL_INTERP(KNT_PTS,NLEV-2)*DP3
!
                INVERSION(KNT_PTS)=.TRUE.
                T_LOWEST(KNT_PTS)=VBL_INTERP(KNT_PTS,NLEV)
                VBL_INTERP(KNT_PTS,NLEV)=(PROD1+PROD2+PROD3)/(DP1+DP2+DP3)
                VBL_INTERP(KNT_PTS,NLEV-1)=(PROD2+PROD3)/(DP2+DP3)
              ENDIF
            ENDDO
            ENDDO
          ENDIF
!
!-----------------------------------------------------------------------
!***  Compute values of the variable at mid-layers of the child
!***  over nest boundary region points based on the parent's
!***  interpolated values.
!-----------------------------------------------------------------------
!
          KNT_PTS  =0
          KNT_PTS_X=0
          LOC_1=(VAR4D_INDX-1)*N_STRIDE*LM  ! In 4D var we cannot start from 0!
          N_ADD=(LM-1)*N_STRIDE
!
!-----------------------------------------------------------------------
!***  Recall that the PDB_H pointer contains data for one extra row
!***  beyond the child boundary on all sides since we need the
!***  ability to do 4-PT averages of PD to V points.   The PDB_V
!***  pointer did not need the extra row and so does not have it.
!***  Here we must use PDB but the values for the prognostic variables
!***  are only generated on the true boundary points.  To address
!***  PDB correctly we loop over the potentially expanded boundary
!***  region but CYCLE when we are at points not within the true
!***  boundary region of the child.
!-----------------------------------------------------------------------
!
          main_loop: DO J=J_START_EXPAND,J_END_EXPAND                      !<-- J limits of expanded child task bndry region on parent task
!
          DO I=I_START_EXPAND,I_END_EXPAND                                 !<-- Child's expanded boundary I values on this parent task
!
!-----------------------------------------------------------------------
!
            KNT_PTS_X=KNT_PTS_X+1                                          !<-- Location in 1-D datastring of child PDB
!
!-----------------------------------------------------------------------
!
            IF(I<I_START.OR.I>I_END                                     &
               .OR.                                                     &
               J<J_START.OR.J>J_END)CYCLE
!
            KNT_PTS=KNT_PTS+1                                              !<-- Location in 1-D datastring of child bndry variable
            LOC_1=LOC_1+1                                                  !<-- Next storage location in the final BC object
!
!-----------------------------------------------------------------------
!***  For 2-D boundary variables the parent simply inserts the 
!***  given I,J value for the single level into the final output
!***  object.
!-----------------------------------------------------------------------
!
            IF(NLEV==1)THEN
              VBL_CHILD_BND(NTX)%DATA(LOC_1)=VBL_INTERP(KNT_PTS,1)
              CYCLE                                                        !<-- Move through the I,J locations disregarding the vertical.
            ENDIF
!
!-----------------------------------------------------------------------
!***  Midlayer pressures for the nest boundary points.
!-----------------------------------------------------------------------
!
            DO L=1,LM                                 
              PMID_CHILD(L)=PSGML1(L)+SGML2(L)*PDB(NTX)%DATA(KNT_PTS_X)    !<-- Nest midlayer pressure
            ENDDO
! 
!-----------------------------------------------------------------------
!***  Use spline interpolation to move variables from their
!***  vertical locations in the column after horizontal interpolation
!***  from the surrounding parent points to child boundary point levels.
!***  The target locations are the new midlayer pressures in the
!***  nest boundary point columns based on the new surface pressure
!***  for the nest's terrain.
!
!***  If the target location lies below the middle of the lowest parent
!***  layer in the newly created child column then extrapolate linearly
!***  in pressure to obtain a value at the lowest child mid-layer and
!***  fill in the remaining 'underground' levels using the call to
!***  'SPLINE' just as with all the other higher levels.
!-----------------------------------------------------------------------
!
            DO L=1,LM                                                      !<-- Extract mid-layer values of parent in nest column
              P_INPUT  (L)=PMID_INTERP(KNT_PTS,L)
              VBL_INPUT(L)= VBL_INTERP(KNT_PTS,L)
            ENDDO
!
            LOC_2=LOC_1+N_ADD
            VBL_COL_CHILD=>VBL_CHILD_BND(NTX)%DATA(LOC_1:LOC_2:N_STRIDE)   !<-- Point working column pointer into 1-D horizontal

            if (VAR4D_INDX.gt.INDX_WATER_END) then

                 call interp_linear(P_INPUT(1:LM)        &
                                   ,VBL_INPUT(1:LM)      &
                                   ,PMID_CHILD(1:LM)     &
                                   ,VBL_COL_CHILD(1:LM))

            else
                NUM_LEVS_SPLINE=LM
                !
                IF(PMID_CHILD(LM)>P_INPUT(LM))THEN                             !<-- Nest's lowest mid-layer is lower than parent's
                    NUM_LEVS_SPLINE=LM+1                                         !<-- Add another input level at nest's lowest
                    P_INPUT(LM+1)=PMID_CHILD(LM)                                 !    mid-layer.
                    !
                    !             IF(TRIM(VBL_FLAG)=='T'.AND.INVERSION(KNT_PTS))THEN           !<-- For temperature inversions place the parent's
                    !               VBL_INPUT(LM+1)=T_LOWEST(KNT_PTS)                          !    original cold sfc lyr into the new bottom lyr.
                    !             ELSE
                    R_DELP=1./(P_INPUT(LM)-P_INPUT(LM-1))
                    DELP_EXTRAP=PMID_CHILD(LM)-P_INPUT(LM)
                    !
                    COEFF_1=(VBL_INPUT(LM)-VBL_INPUT(LM-1))*R_DELP
                    FACTOR=HYPER_A/(DELP_EXTRAP+HYPER_A)
                    VBL_INPUT(LM+1)=VBL_INPUT(LM)                           &  !<-- Extrapolated value at nest's new bottom
                            +COEFF_1*DELP_EXTRAP*FACTOR                 !    midlayer.
                    !             ENDIF
                    !
                ENDIF
                !
                DO L=1,LM+1
                    SEC_DERIV(L)=0.                                              !<-- Initialize 2nd derivatives of the spline to zero.
                ENDDO
                !
                CALL SPLINE(NUM_LEVS_SPLINE                                 &  !<-- # of input levels
                        ,P_INPUT(1:NUM_LEVS_SPLINE)                      &  !<-- Input mid-layer pressures
                        ,VBL_INPUT(1:NUM_LEVS_SPLINE)                    &  !<-- Input mid-layer mass variable value
                        ,SEC_DERIV                                       &  !<-- Specified 2nd derivatives (=0) at parent points
                        ,NUM_LEVS_SEC                                    &
                        ,LM                                              &  !<-- # of child mid-layers to interpolate to
                        ,PMID_CHILD                                      &  !<-- Child mid-layer pressures to interpolate to
                        ,VBL_COL_CHILD)                                     !<-- Child mid-layer variable value returned
            endif
!     if(n_side==2.and.i==isee.and.j==jsee.and.trim(vbl_name)=='T-nestbc')THEN
!       write(0,69471)ntx,loc_1,loc_2,n_stride,vbl_child_bnd(ntx)%data(loc_1)
!       write(0,69476)knt_pts,vbl_input(1),vbl_input(2),vbl_input(3)
!       write(0,69477)p_input(1),p_input(2),p_input(3)
69471   format(' PARENT_UPDATE_CHILD_BNDRY T after SPLINE ntx=',i2,' loc_1=',i5,' loc_2=',i5,' n_stride=',i5 &
              ,' vbl_child_bnd(ntx)%data(loc_1)=',f6.2)
69476   format(' knt_pts=',i6,' vbl_input=',3(1x,f6.2))
69477   format(' p_input=',3(1x,f9.2))
!     endif
!
!-----------------------------------------------------------------------
!
          ENDDO
          ENDDO main_loop
!
!-----------------------------------------------------------------------
!
          DEALLOCATE(PMID_INTERP)
          DEALLOCATE(VBL_INTERP)
          DEALLOCATE(INVERSION)
          DEALLOCATE(T_LOWEST)
!
          DEALLOCATE(PINT_INTERP_HI)
          DEALLOCATE(PINT_INTERP_LO)
!
!-----------------------------------------------------------------------
!
        ENDDO child_task_loop
!
!.......................................................................
!$omp end parallel do
!.......................................................................
!
!-----------------------------------------------------------------------
!
      ENDDO loop_sides
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_UPDATE_CHILD_BNDRY
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PRESSURE_ON_NEST_BNDRY_V(PD_H                          &
                                         ,IMS,IME,JMS,JME               &
!
                                         ,PDB_S_H                       &
                                         ,PDB_N_H                       &
                                         ,PDB_W_H                       &
                                         ,PDB_E_H                       &
!
                                         ,NUM_TASKS_SEND_SBND           &
                                         ,NUM_TASKS_SEND_NBND           &
                                         ,NUM_TASKS_SEND_WBND           &
                                         ,NUM_TASKS_SEND_EBND           &
!
                                         ,I_LO_SOUTH_V                  &
                                         ,I_HI_SOUTH_V                  &
                                         ,I_LO_NORTH_V                  &
                                         ,I_HI_NORTH_V                  &
                                         ,J_LO_WEST_V                   &
                                         ,J_HI_WEST_V                   &
                                         ,J_LO_EAST_V                   &
                                         ,J_HI_EAST_V                   & 
!
                                         ,I_LO_SOUTH_H                  &
                                         ,I_HI_SOUTH_H                  &
                                         ,I_LO_NORTH_H                  &
                                         ,I_HI_NORTH_H                  &
                                         ,J_LO_WEST_H                   &
                                         ,J_HI_WEST_H                   &
                                         ,J_LO_EAST_H                   &
                                         ,J_HI_EAST_H                   & 
!                                                                               ^
                                         ,N_BLEND_H_CHILD               & !     |
                                         ,N_BLEND_V_CHILD               & !     |
                                         ,IM_CHILD                      & !     |
                                         ,JM_CHILD                      & !     |
                                                                          !     |
                                         ,INC_FIX_N                     & !   Input
!                                                                           ---------
                                         ,PD_V                          & !   Output
                                         ,PDB_S_V                       & !     |
                                         ,PDB_N_V                       & !     |
                                         ,PDB_W_V                       & !     v
                                         ,PDB_E_V )                       !  
!
!-----------------------------------------------------------------------
!***  Use 4-pt horizontal interpolation to compute PD on V points
!***  of the parent domain and of the nest boundary given those 
!***  values on H points.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: IMS,IME,JMS,JME                  &  !<-- Parent task's memory limits
                                      ,IM_CHILD,JM_CHILD                &  !<-- Nest domain limits
                                      ,INC_FIX_N                        &  !<-- Increment for selecting nest tasks for averaging H to V
                                      ,N_BLEND_H_CHILD                  &  !<-- H rows in nest's boundary region
                                      ,N_BLEND_V_CHILD                  &  !<-- V rows in nest's boundary region
                                      ,NUM_TASKS_SEND_SBND              &  !<-- # of child tasks with Sbndry V points on parent task
                                      ,NUM_TASKS_SEND_NBND              &  !<-- # of child tasks with Nbndry V points on parent task
                                      ,NUM_TASKS_SEND_WBND              &  !<-- # of child tasks with Wbndry V points on parent task
                                      ,NUM_TASKS_SEND_EBND                 !<-- # of child tasks with Ebndry V points on parent task
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) ::             &
                                                        I_LO_SOUTH_H    &  !<-- Starting I of Sbndry region H points on child tasks
                                                       ,I_HI_SOUTH_H    &  !<-- Ending I of Sbndry region H points on child tasks
                                                       ,I_LO_NORTH_H    &  !<-- Starting I of Nbndry region H points on child tasks
                                                       ,I_HI_NORTH_H    &  !<-- Ending I of Nbndry region H points on child tasks
                                                       ,J_LO_WEST_H     &  !<-- Starting J of Wbndry region H points on child tasks
                                                       ,J_HI_WEST_H     &  !<-- Ending J of Wbndry region H points on child tasks
                                                       ,J_LO_EAST_H     &  !<-- Starting J of Ebndry region H points on child tasks
                                                       ,J_HI_EAST_H        !<-- Ending J of Ebndry region H points on child tasks
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER,INTENT(IN) ::             &
                                                        I_LO_SOUTH_V    &  !<-- Starting I of Sbndry region V points on child tasks
                                                       ,I_HI_SOUTH_V    &  !<-- Ending I of Sbndry region V points on child tasks
                                                       ,I_LO_NORTH_V    &  !<-- Starting I of Nbndry region V points on child tasks
                                                       ,I_HI_NORTH_V    &  !<-- Ending I of Nbndry region V points on child tasks
                                                       ,J_LO_WEST_V     &  !<-- Starting J of Wbndry region V points on child tasks
                                                       ,J_HI_WEST_V     &  !<-- Ending J of Wbndry region V points on child tasks
                                                       ,J_LO_EAST_V     &  !<-- Starting J of Ebndry region V points on child tasks
                                                       ,J_HI_EAST_V        !<-- Ending J of Ebndry region V points on child tasks
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PD_H        !<-- Parent PD (Pa) (column mass in sigma domain) on H points
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(IN) :: PDB_S_H        &  !<-- Boundary region PD (Pa) (column mass in sigma domain)
                                                        ,PDB_N_H        &  !    on mass points on the four sides of the child boundary.
                                                        ,PDB_W_H        &  !
                                                        ,PDB_E_H           !<--
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PD_V       !<-- Parent PD (Pa) (column mass in sigma domain) on V points
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER,INTENT(INOUT) :: PDB_S_V     &  !<-- Child boundary PD (Pa) on child domain Sbndry V points
                                                           ,PDB_N_V     &  !<-- Child boundary PD (Pa) on child domain Nbndry V points
                                                           ,PDB_W_V     &  !<-- Child boundary PD (Pa) on child domain Wbndry V points
                                                           ,PDB_E_V        !<-- Child boundary PD (Pa) on child domain Ebndry V points
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: DIFF_START,DIFF_START_PTS                   &
                           ,I,J                                         &
                           ,I_ADD_H,I_INC_H                             &
                           ,I_START_H,I_START_V                         &
                           ,I_END_H,I_END_V                             &
                           ,I_HI_H,I_LO_H                               &
                           ,J_START_H,J_START_V                         &
                           ,J_END_H,J_END_V                             &
                           ,KNT_H,KNT_V                                 &
                           ,N_ADD_H,N_OFFSET_H,N_SIDE                   &
                           ,NTX,NTX_H,NUM_TASKS_SEND
!
      INTEGER(kind=KINT),DIMENSION(4) :: NTX_ADD
!
      TYPE(REAL_DATA),DIMENSION(:),POINTER :: PDB_H                     &
                                             ,PDB_V
!
      integer,dimension(8) :: values
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      DO N_SIDE=1,4
        NTX_ADD(N_SIDE)=0
      ENDDO
!
!-----------------------------------------------------------------------
!***  First obtain PD on the parent's V points.
!-----------------------------------------------------------------------
!
      DO J=JMS,JME-1
      DO I=IMS,IME-1
        PD_V(I,J)=0.25*(PD_H(I,J)+PD_H(I+1,J)+PD_H(I,J+1)+PD_H(I+1,J+1))
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!***  Now average values of PD on and adjacent to the nests' boundary
!***  to obtain PD on the nests' boundary V points.
!-----------------------------------------------------------------------
!
      loop_sides: DO N_SIDE=1,4                                            !<-- Loop through the 4 lateral boundaries (S,N,W,E)
!
!-----------------------------------------------------------------------
!
        IF(N_SIDE==1)THEN
          IF(NUM_TASKS_SEND_SBND==0)CYCLE                                  !<-- Move on if parent task sees no part of nest's Sbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_SBND                               !<-- # of Sbndry nest tasks to which parent sends PDB on V
          PDB_H=>PDB_S_H                                                   !<-- String of Sbndry PDB on H for this nest task
          PDB_V=>PDB_S_V                                                   !<-- String of Sbndry PDB on V for this nest task
!
!
        ELSEIF(N_SIDE==2)THEN
          IF(NUM_TASKS_SEND_NBND==0)CYCLE                                  !<-- Move on if parent task sees no part of nest's Nbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_NBND                               !<-- # of Nbndry nest tasks to which parent sends PDB on V
          PDB_H=>PDB_N_H                                                   !<-- String of Nbndry PDB on H for this nest task
          PDB_V=>PDB_N_V                                                   !<-- String of Nbndry PDB on V for this nest task
!
        ELSEIF(N_SIDE==3)THEN
          IF(NUM_TASKS_SEND_WBND==0)CYCLE                                  !<-- Move on if parent task sees no part of nest's Wbndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_WBND                               !<-- # of Wbndry nest tasks to which parent sends PDB on V
          PDB_H=>PDB_W_H                                                   !<-- String of Wbndry PDB on H for this nest task
          PDB_V=>PDB_W_V                                                   !<-- String of Wbndry PDB on V for this nest task
!
        ELSEIF(N_SIDE==4)THEN
          IF(NUM_TASKS_SEND_EBND==0)CYCLE                                  !<-- Move on if parent task sees no part of nest's Ebndry
!
          NUM_TASKS_SEND=NUM_TASKS_SEND_EBND                               !<-- # of Ebndry nest tasks to which parent sends PDB on V
          PDB_H=>PDB_E_H                                                   !<-- String of Ebndry PDB on H for this nest task
          PDB_V=>PDB_E_V                                                   !<-- String of Ebndry PDB on V for this nest task
!
        ENDIF
!
!-----------------------------------------------------------------------
!
        child_task_loop: DO NTX=1,NUM_TASKS_SEND                           !<-- Compute PD on V points for each child task with
                                                                           !    bndry segments seen by this parent task.
!-----------------------------------------------------------------------
!
!----------------------------------------------
!***  South boundary limits on this child task
!----------------------------------------------
!
          IF(N_SIDE==1)THEN
            I_START_V=I_LO_SOUTH_V(NTX)                                    !<-- I index of first Sbndry V point on this child task
            I_END_V  =I_HI_SOUTH_V(NTX)                                    !<-- I index of last Sbndry V point on this child task
            J_START_V=1                                                    !<-- J index of first Sbndry V point on this child task
            J_END_V  =N_BLEND_V_CHILD                                      !<-- J index of last Sbndry V point on this child task
!
            I_END_H  =I_HI_SOUTH_H(NTX)                                    !<-- I index of last Sbndry H point east of last Sbndry V point
!
            IF(NTX==1.AND.NUM_TASKS_SEND>1)THEN
              IF(I_START_V==I_LO_SOUTH_H(NTX+1)+INC_FIX_N              &
                       .AND.                                           &
                 I_END_V>=I_END_H)THEN
                NTX_ADD(N_SIDE)=1
              ENDIF
            ENDIF
!
            NTX_H=NTX+NTX_ADD(N_SIDE)                                      !<-- Reference parent task for PDB on nest H points
            DIFF_START=I_START_V-I_LO_SOUTH_H(NTX_H)
            I_HI_H=I_HI_SOUTH_H(NTX_H)
            I_LO_H=I_LO_SOUTH_H(NTX_H)
            N_ADD_H=I_HI_H-I_LO_H+1
!
!----------------------------------------------
!***  North boundary limits on this child task
!----------------------------------------------
!
          ELSEIF(N_SIDE==2)THEN
            I_START_V=I_LO_NORTH_V(NTX)                                    !<-- I index of first Nbndry V point on this child task
            I_END_V  =I_HI_NORTH_V(NTX)                                    !<-- I index of last Nbndry V point on this child task
            J_START_V=JM_CHILD-N_BLEND_V_CHILD                             !<-- J index of first Nbndry V point on this child task
            J_END_V  =JM_CHILD-1                                           !<-- J index of last Nbndry V point on this child task
!
            I_END_H  =I_HI_NORTH_H(NTX)                                    !<-- I index of last Nbndry H point east of last Nbndry V point
!
            IF(NTX==1.AND.NUM_TASKS_SEND>1)THEN                                                                                     
              IF(I_START_V==I_LO_NORTH_H(NTX+1)+INC_FIX_N               &                                                           
                       .AND.                                            &                                                           
                 I_END_V>=I_END_H)THEN
                NTX_ADD(N_SIDE)=1
              ENDIF
            ENDIF
!
            NTX_H=NTX+NTX_ADD(N_SIDE)                                      !<-- Reference parent task for PDB on nest H points
            DIFF_START=I_START_V-I_LO_NORTH_H(NTX_H)
            I_HI_H=I_HI_NORTH_H(NTX_H)
            I_LO_H=I_LO_NORTH_H(NTX_H)
            N_ADD_H=I_HI_H-I_LO_H+1
!
!----------------------------------------------
!***  West boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==3)THEN
            I_START_V=1                                                    !<-- I index of first Wbndry V point on this child task
            I_END_V  =N_BLEND_V_CHILD                                      !<-- I index of last Wbndry V point on this child task
            J_START_V=J_LO_WEST_V(NTX)                                     !<-- J index of first Wbndry V point on this child task
            J_END_V  =J_HI_WEST_V(NTX)                                     !<-- J index of last Wbndry V point on this child task
!
            J_END_H  =J_HI_WEST_H(NTX)                                     !<-- J index of last Wbndry H point east of last Wbndry V point
!
            IF(NTX==1.AND.NUM_TASKS_SEND>1)THEN
              IF(J_START_V==J_LO_WEST_H(NTX+1)+INC_FIX_N                &                  
                       .AND.                                            &                  
                 J_END_V>=J_END_H)THEN
                NTX_ADD(N_SIDE)=1
              ENDIF
            ENDIF
!
            NTX_H=NTX+NTX_ADD(N_SIDE)                                      !<-- Reference parent task for PDB on nest H points
            DIFF_START=J_START_V-J_LO_WEST_H(NTX_H)
            DIFF_START_PTS=DIFF_START*(N_BLEND_H_CHILD+1)
            N_ADD_H=N_BLEND_H_CHILD+1
!
!---------------------------------------------
!***  East boundary limits on this child task
!---------------------------------------------
!
          ELSEIF(N_SIDE==4)THEN
            I_START_V=IM_CHILD-N_BLEND_V_CHILD                             !<-- I index of first Ebndry V point on this child task
            I_END_V  =IM_CHILD-1                                           !<-- I index of last Ebndry V point on this child task
            J_START_V=J_LO_EAST_V(NTX)                                     !<-- J index of first Ebndry V point on this child task
            J_END_V  =J_HI_EAST_V(NTX)                                     !<-- J index of last Ebndry V point on this child task
!
            J_END_H  =J_HI_EAST_H(NTX)                                     !<-- J index of last Ebndry H point east of last Ebndry V point
!
            IF(NTX==1.AND.NUM_TASKS_SEND>1)THEN
              IF(J_START_V==J_LO_EAST_H(NTX+1)+INC_FIX_N                &         
                       .AND.                                            &         
                 J_END_V>=J_END_H)THEN
                NTX_ADD(N_SIDE)=1
              ENDIF
            ENDIF
!
            NTX_H=NTX+NTX_ADD(N_SIDE)                                      !<-- Reference parent task for PDB on nest H points
            DIFF_START=J_START_V-J_LO_EAST_H(NTX_H)
            DIFF_START_PTS=DIFF_START*(N_BLEND_H_CHILD+1)
            N_ADD_H=N_BLEND_H_CHILD+1
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  Ready to average nest boundary PD on H to PD on V.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Recall that the PDB_H pointer contains data for one extra row
!***  beyond the child boundary on all sides since we need the
!***  ability to do 4-pt averages of PD to V points.
!***  Here we must use PDB_H but the values for PDB_V (and thus U,V)
!***  are only generated on the true boundary points.  To address PDB_H
!***  correctly we must take into account those extra points in PDB_H
!***  as we march through the V point locations.
!
!***  Also we must be aware that the nest boundary V segments that are
!***  being considered for each nest task must correspond to the same
!***  nest task H point values of PDB.  Because of overlap that can
!***  occur due to the segments of PDB on H being larger than PBD on
!***  V we must explicitly check to be sure that nest PDB on V is
!***  being filled by nest PDB on H for the same nest task.
!-----------------------------------------------------------------------
!
          KNT_V=0
!
          DO J=J_START_V,J_END_V
            IF(N_SIDE<=2)THEN
              N_OFFSET_H=(DIFF_START+1)*(J-J_START_V+1)-1
            ELSEIF(N_SIDE>=3)THEN
              N_OFFSET_H=J-J_START_V+DIFF_START_PTS
            ENDIF
!
            DO I=I_START_V,I_END_V
              KNT_V=KNT_V+1
              KNT_H=KNT_V+N_OFFSET_H
              PDB_V(NTX)%DATA(KNT_V)=(PDB_H(NTX_H)%DATA(KNT_H)            &
                                     +PDB_H(NTX_H)%DATA(KNT_H+1)          &
                                     +PDB_H(NTX_H)%DATA(KNT_H+N_ADD_H)    &
                                     +PDB_H(NTX_H)%DATA(KNT_H+N_ADD_H+1)) &
                                     *0.25
!     if(i==36.and.n_side==2)then
!       write(0,*)' PRESSURE_ON_NEST_BNDRY_V j=',j,' ntx=',ntx,' n_offset_h=',n_offset_h
!       write(0,*)' pdb_v=',pdb_v(ntx)%data(knt_v),' knt_v=',knt_v,' knt_h=',knt_h
!       write(0,*)' pdb_h=',PDB_H(NTX_H)%DATA(KNT_H),PDB_H(NTX_H)%DATA(KNT_H+1) &
!                ,PDB_H(NTX_H)%DATA(KNT_H+N_ADD_H),PDB_H(NTX_H)%DATA(KNT_H+N_ADD_H+1)
!     endif
            ENDDO
          ENDDO
!
!-----------------------------------------------------------------------
!
        ENDDO child_task_loop
!
!-----------------------------------------------------------------------
!
      ENDDO loop_sides
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PRESSURE_ON_NEST_BNDRY_V
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PARENT_2WAY_UPDATE(I_2WAY_UPDATE_START                 &
                                   ,I_2WAY_UPDATE_END                   &
                                   ,J_2WAY_UPDATE_START                 &
                                   ,J_2WAY_UPDATE_END                   &
                                   ,LM                                  &
                                   ,NPTS_UPDATE_HORIZ                   &
                                   ,NPTS_UPDATE_TOTAL                   &
                                   ,NVARS_2WAY_UPDATE                   &
                                   ,VAR_2WAY                            &
                                   ,CHILD_SFC_ON_PARENT_GRID            &
                                   ,WGT_CHILD                           &
                                   ,FIS                                 &
                                   ,PD,PDTOP,PT                         & !   ^
                                   ,SG1,SG2                             & !   |
                                   ,IMS,IME,JMS,JME                     & !   |
                                                                          ! input
!                                                                           -----
                                   ,BUNDLE_2WAY                         & ! output
                                           )
!
!-----------------------------------------------------------------------
!***  Parent tasks incorporate new 2-way exchange data sent from the
!***  children.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: I_2WAY_UPDATE_START              &  !<-- Starting parent I of its 2-way update region
                                      ,I_2WAY_UPDATE_END                &  !<-- Ending parent I of its 2-way update region
                                      ,J_2WAY_UPDATE_START              &  !<-- Starting parent J of its 2-way update region
                                      ,J_2WAY_UPDATE_END                &  !<-- Ending parent J of its 2-way update region
                                      ,LM                                  !<-- # of model layers (all domains)
!
      INTEGER(kind=KINT),INTENT(IN) :: NPTS_UPDATE_HORIZ                &  !<-- # of parent sfc H,V points updated in the horizontal
                                      ,NPTS_UPDATE_TOTAL                &  !<-- Total # of words in 2-way 3D update data from child
                                      ,NVARS_2WAY_UPDATE                   !<-- # of variables updated in 2-way exchange
!
      INTEGER(kind=KINT),INTENT(IN) :: IMS,IME,JMS,JME                     !<-- Parent subdomain memory limits
!
      REAL(kind=KFPT),INTENT(IN) :: PDTOP                               &  !<-- Pressure at top of the sigma domain (Pa)
                                   ,PT                                  &  !<-- Pressure at the top of the domain (Pa)
                                   ,WGT_CHILD                              !<-- Weight (0-1) given to child 2-way data in the update
!
      REAL(kind=KFPT),DIMENSION(1:NPTS_UPDATE_HORIZ,1:2),INTENT(IN) ::  &
                                               CHILD_SFC_ON_PARENT_GRID    !<-- Child's FIS(:,1),PD(:,2) interpolated to parent update pts
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS      &  !<-- Parent's sfc geopotential (m2/s2)
                                                              ,PD          !<-- Parent's PD (Pa)
!
      REAL(kind=KFPT),DIMENSION(1:LM+1),INTENT(IN) :: SG1,SG2              !<-- Interface 'sigma' values in pressure and hybrid regions
!
      REAL(kind=KFPT),DIMENSION(1:NPTS_UPDATE_TOTAL),TARGET             &
                                             ,INTENT(INOUT):: VAR_2WAY     !<-- String of all 2-way update data from child
!
      TYPE(ESMF_FieldBundle),INTENT(INOUT) :: BUNDLE_2WAY                  !<-- Object holding pointes to the 2-way exchange variables
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: I,IPTS,J,JPTS,KNT,KNT_HZ                    &
                           ,L,L1,L2,LOC1_2WAY,LOC2_2WAY                 &
                           ,N_STRIDE,NL,NPTS_3D,NPTS_HZ                 &
                           ,NUM_DIMS,NUM_LEVS_SEC,NUM_LEVS_SPLINE,NV
!
      INTEGER(kind=KINT) :: RC,RC_UPD
!
      REAL(kind=KFPT) :: COEFF_1,DELP_EXTRAP,FACTOR,PDTOP_PT            &
                        ,PINT_HI_CHILD,PINT_HI_PARENT,PINT_LO           &
                        ,R_DELP,WGT_PARENT
!
      REAL(kind=KFPT),DIMENSION(1:LM) :: PMID_PARENT                    &
                                        ,VBL_OUT
!
      REAL(kind=KFPT),DIMENSION(1:LM+1) :: PMID_CHILD                   &
                                          ,SEC_DERIV
!
      REAL(kind=KFPT) :: PMID_CHILD_LM,PMID_CHILD_LM1                   &
                        ,PROD_LM,PROD_LM1,PROD_LM2                      &
                        ,VBL_LM,VBL_LM1
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: VBL_COL,VBL_X
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: VAR_PARENT_2D
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: VAR_PARENT_3D         &
                                                 ,VAR_3D
!
      REAL(kind=KFPT),DIMENSION(:,:,:,:),POINTER :: VAR_PARENT_4D
!
      LOGICAL(kind=KLOG) :: EXTRAPOLATE
!
      CHARACTER(len=99) :: FIELD_NAME
!
      TYPE(ESMF_Field) :: HOLD_FIELD
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  The parent does not incorporate data sent from the child if
!***  this is a parent timestep that immediately follows the writing
!***  of a restart file.  This ensures bit-reproducible restarts.
!***  A child sends 2-way data to its parent at the end of parent
!***  timestep N and the parent receives that data early in timestep
!***  N+1.  Two-way data is not in the restart files so in a restart
!***  the parent sees no 2-way data coming from its children in the
!***  first timestep.  Therefore the parent must not use 2-way data
!***  from the children in any parent timestep that follows the
!***  writing of a restart file.
!-----------------------------------------------------------------------
!
      NUM_LEVS_SEC=LM+1
      WGT_PARENT=1.-WGT_CHILD
!
!-----------------------------------------------------------------------
!
      IPTS=I_2WAY_UPDATE_END-I_2WAY_UPDATE_START+1                         !<-- # of parent points updated in I dimension
      JPTS=J_2WAY_UPDATE_END-J_2WAY_UPDATE_START+1                         !<-- # of parent points updated in J dimension
      NPTS_HZ=IPTS*JPTS                                                    !<-- # of parent update points in the horizontal
      NPTS_3D=NPTS_HZ*LM                                                   !<-- # of parent points updated for each 3D variable
!
      KNT=0                                                                !<-- Count words in 2-D string of 2-way exchange variables
!
!-----------------------------------------------------------------------
!***  Loop through all the 2-way exchange variables.
!-----------------------------------------------------------------------
!
      vars: DO NV=1,NVARS_2WAY_UPDATE
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Field from the Bundle of 2-way Vbls"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(FIELDBUNDLE=BUNDLE_2WAY                &  !<-- Bundle holding the arrays for move updates
                                ,fieldIndex =NV                         &  !<-- Index of the Field in the Bundle
                                ,field      =HOLD_FIELD                 &  !<-- Field NV in the Bundle
                                ,rc         =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_UPD)
!-----------------------------------------------------------------------
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Info about this 2-way Variable"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldGet(field   =HOLD_FIELD                          &  !<-- Field N_FIELD in the Bundle
                          ,dimCount=NUM_DIMS                            &  !<-- Is this Field 2-D or 3-D?
                          ,typeKind=DATATYPE                            &  !<-- Does the Field contain an integer or real array?
                          ,name    =FIELD_NAME                          &  !<-- This variable's name.
                          ,rc      =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_UPD)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
        ndim: IF(NUM_DIMS==2)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Real 2-way 2-D Array from the Field"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field    =HOLD_FIELD                       &  !<-- Field that holds the exchange variable pointer
                            ,localDe  =0                                &
                            ,farrayPtr=VAR_PARENT_2D                    &  !<-- Put the pointer here
                            ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_UPD)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          DO J=J_2WAY_UPDATE_START,J_2WAY_UPDATE_END
          DO I=I_2WAY_UPDATE_START,I_2WAY_UPDATE_END
!
            KNT=KNT+1
!
            VAR_PARENT_2D(I,J)=VAR_2WAY(KNT)*WGT_CHILD                  &  !<-- The 2-way data from the child provides the fraction
                              +VAR_PARENT_2D(I,J)*WGT_PARENT               !    WGT_CHILD of the final updated parent value.
!
          ENDDO
          ENDDO
!
!-----------------------------------------------------------------------
!
        ELSEIF(NUM_DIMS>=3)THEN
!
!-----------------------------------------------------------------------
!
          IF(NUM_DIMS==3)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Real 2-way 3-D Array from the Field"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field    =HOLD_FIELD                     &  !<-- Field that holds the exchange variable pointer
                              ,localDe  =0                              &
                              ,farrayPtr=VAR_PARENT_3D                  &  !<-- Put the pointer here
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_UPD)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            L1=1
            L2=1
!
!-----------------------------------------------------------------------
!
          ELSEIF(NUM_DIMS==4)THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract Real 2-way 4-D Array from the Field"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_FieldGet(field    =HOLD_FIELD                     &  !<-- Field that holds the exchange variable pointer
                              ,localDe  =0                              &
                              ,farrayPtr=VAR_PARENT_4D                  &  !<-- Put the pointer here
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_UPD)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            L1=LBOUND(VAR_PARENT_4D,4)
            L2=UBOUND(VAR_PARENT_4D,4)
!
          ENDIF
!
!-----------------------------------------------------------------------
!
          nl_loop: DO NL=L1,L2                                             !<-- Loop through exchange variable's 4th dimension
!                                                                               if it exists.
            KNT_HZ=0
!
            DO J=J_2WAY_UPDATE_START,J_2WAY_UPDATE_END
            DO I=I_2WAY_UPDATE_START,I_2WAY_UPDATE_END
!
!-----------------------------------------------------------------------
!
              KNT_HZ=KNT_HZ+1
              EXTRAPOLATE=.FALSE.
!
!-----------------------------------------------------------------------
!***  If either the interpolated nest sfc or the parent sfc lies
!***  above sea level then the parent adjusts the child data in
!***  the vertical to account for different topographies.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
              adjust: IF(CHILD_SFC_ON_PARENT_GRID(KNT_HZ,1)>1.          &  !<-- Child's interpolated sfc is above sea level
                            .OR.                                        &
                         FIS(I,J)>1.)THEN                                  !<-- Parent's sfc is above sea level
!-----------------------------------------------------------------------
!
                PDTOP_PT=SG1(1)*PDTOP+PT
                PINT_HI_CHILD=SG2(1)*CHILD_SFC_ON_PARENT_GRID(KNT_HZ,2)+PDTOP_PT
                PINT_HI_PARENT=SG2(1)*PD(I,J)+PDTOP_PT
!
                DO L=1,LM
                  PDTOP_PT=SG1(L+1)*PDTOP+PT
                  PINT_LO=SG2(L+1)*CHILD_SFC_ON_PARENT_GRID(KNT_HZ,2)+PDTOP_PT
                  PMID_CHILD(L)=0.5*(PINT_HI_CHILD+PINT_LO)                !<-- Midlayer P of 2-way data from child at parent I,J
                  PINT_HI_CHILD=PINT_LO
!
                  PINT_LO=SG2(L+1)*PD(I,J)+PDTOP_PT
                  PMID_PARENT(L)=0.5*(PINT_HI_PARENT+PINT_LO)              !<-- Current midlayer pressure at parent I,J
                  PINT_HI_PARENT=PINT_LO
                ENDDO
!
                NUM_LEVS_SPLINE=LM
!
                DO L=1,NUM_LEVS_SEC
                  SEC_DERIV(L)=0.                                          !<-- Needed in the SPLINE subroutine
                ENDDO
!
!-----------------------------------------------------------------------
!***  If the target parent midlayer pressure level lies below the
!***  lowest child input midlayer (interpolated) pressure then
!***  extrapolate linearly downward in pressure to obtain an
!***  artificial child input value at the lowest parent midlayer
!***  pressure then fill in the remaining 'underground' parent levels
!***  using SPLINE just as is done with all the higher levels.
!
!***  In order to reduce the effects of the ground surface, the lowest
!***  input layer is changed to be the mass-weighted average of the
!***  original two lowest layers while the 2nd lowest input layer is
!***  changed to be the mass-weighted average of the three original
!***  lowest layers.
!-----------------------------------------------------------------------
!
                IF(PMID_PARENT(LM)>PMID_CHILD(LM))THEN
                  EXTRAPOLATE=.TRUE.
                  NUM_LEVS_SPLINE=LM+1                                     !<-- Insert 'underground' artificial input level from child
!
                  PMID_CHILD(LM+1)=PMID_PARENT(LM)                         !<-- 'Underground' child P is the  parent's bottom midlayer P
                  ALLOCATE(VBL_X(1:LM+1))                                  !<-- Allocate 2-way data input column with extra bottom layer
                ENDIF
!
                LOC1_2WAY=(NV-1)*NPTS_3D                                &  !<-- The 1st word of the column of 2-way data in 1-D data
                          +(J-J_2WAY_UPDATE_START)*IPTS                 &  !    recvd from child for variable NV at parent I,J.
                          +(I-I_2WAY_UPDATE_START+1)
                LOC2_2WAY=LOC1_2WAY+(LM-1)*NPTS_HZ                         !<-- The last word of parent I,J column in 2-way exchange data.
                N_STRIDE=NPTS_HZ                                           !<-- Stride between points in this I,J column.
!
                VBL_COL=>VAR_2WAY(LOC1_2WAY:LOC2_2WAY:N_STRIDE)            !<-- Pre-adjusted values in this column of the input 2-way data
!
                IF(.NOT.EXTRAPOLATE)THEN
                  VBL_X=>VBL_COL                                           !<-- No extrapolation so no need to copy values
!
                ELSEIF(EXTRAPOLATE)THEN
                  DO L=1,LM-2
                    VBL_X(L)=VBL_COL(L)                                    !<-- Copy the genuine values from the input column
                  ENDDO
!
                  PROD_LM=VBL_COL(LM)*PMID_CHILD(LM)
                  PROD_LM1=VBL_COL(LM-1)*PMID_CHILD(LM-1)
                  PROD_LM2=VBL_COL(LM-2)*PMID_CHILD(LM-2)
                  VBL_LM=(PROD_LM+PROD_LM1)                             &
                        /(PMID_CHILD(LM)+PMID_CHILD(LM-1))
                  VBL_LM1=(PROD_LM+PROD_LM1+PROD_LM2)                   &
                        /(PMID_CHILD(LM)+PMID_CHILD(LM-1)               &
                         +PMID_CHILD(LM-2))
                  VBL_X(LM)=VBL_LM
                  VBL_X(LM-1)=VBL_LM1
                  PMID_CHILD_LM=0.5*(PMID_CHILD(LM-1)+PMID_CHILD(LM))
                  PMID_CHILD_LM1=(PMID_CHILD(LM-2)+PMID_CHILD(LM-1)     &
                                 +PMID_CHILD(LM))/3.
                  PMID_CHILD(LM)=PMID_CHILD_LM
                  PMID_CHILD(LM-1)=PMID_CHILD_LM1
                  R_DELP=1./(PMID_CHILD(LM)-PMID_CHILD(LM-1))
                  DELP_EXTRAP=PMID_PARENT(LM)-PMID_CHILD(LM)
!
                  COEFF_1=(VBL_X(LM)-VBL_X(LM-1))*R_DELP
                  FACTOR=HYPER_A/(DELP_EXTRAP+HYPER_A)
                  VBL_X(LM+1)=VBL_X(LM)                                 &  !<-- Fill in the extra artificial underground value
                             +COEFF_1*DELP_EXTRAP*FACTOR                   !    in 2-way input.
!
                ENDIF
!
                CALL SPLINE(NUM_LEVS_SPLINE                             &  !<-- # of midlayers in column of child input 2-way data
                           ,PMID_CHILD                                  &  !<-- Interpolated input pressures at child's midlayers
                           ,VBL_X                                       &  !<-- Input values of variable in column at parent I,J
                           ,SEC_DERIV                                   &
                           ,NUM_LEVS_SEC                                &
                           ,LM                                          &  !<-- Interpolate to this many parent midlayers
                           ,PMID_PARENT                                 &  !<-- Target output pressures at parent's midlayers
                           ,VBL_OUT)                                       !<-- Values in the column at I,J adjusted for topo differences
!
                DO L=1,LM
                  VBL_COL(L)=VBL_OUT(L)                                    !<-- Transfer adjusted column values back into 2-way data
                ENDDO
!
                IF(EXTRAPOLATE)THEN                                        !<-- VBL_X is explicitly allocated only if EXTRAPOLATE is true.
                  DEALLOCATE(VBL_X)
                ENDIF
!
!-----------------------------------------------------------------------
!
              ENDIF adjust
!
!-----------------------------------------------------------------------
!
            ENDDO
            ENDDO
!
!-----------------------------------------------------------------------
!***  Now the parent simply updates its values of the exchange
!***  variables at its update points using a weighted average
!***  between its original values and those coming from the child.
!-----------------------------------------------------------------------
!
            IF(NUM_DIMS==3)THEN
              VAR_3D=>VAR_PARENT_3D
            ELSEIF(NUM_DIMS==4)THEN
              VAR_3D=>VAR_PARENT_4D(:,:,:,NL)
            ENDIF
!
            DO L=1,LM
              DO J=J_2WAY_UPDATE_START,J_2WAY_UPDATE_END
              DO I=I_2WAY_UPDATE_START,I_2WAY_UPDATE_END
!
                KNT=KNT+1
!
                VAR_3D(I,J,L)=VAR_2WAY(KNT)*WGT_CHILD                   &  !<-- The 2-way data from the child provides the fraction
                             +VAR_3D(I,J,L)*WGT_PARENT                     !    WGT_CHILD of the final updated parent value.
!
              ENDDO
              ENDDO
!
            ENDDO
!
!-----------------------------------------------------------------------
!
          ENDDO nl_loop
!
!-----------------------------------------------------------------------
!
        ENDIF ndim
!
!-----------------------------------------------------------------------
!
      ENDDO vars
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PARENT_2WAY_UPDATE
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE CHILD_DATA_FROM_STRING(LENGTH_DATA                     &
                                       ,DATASTRING                      &
                                       ,ILIM_LO,ILIM_HI                 &
                                       ,JLIM_LO,JLIM_HI                 &
                                       ,I_START,I_END                   &
                                       ,J_START,J_END                   &
                                       ,NVARS_BC_2D_H                   &
                                       ,NVARS_BC_3D_H                   &
                                       ,NVARS_BC_4D_H                   &
                                       ,LBND_4D                         &
                                       ,UBND_4D                         &
                                       ,NVARS_BC_2D_V                   &
                                       ,NVARS_BC_3D_V                   &
                                       ,PDB                             &
                                       ,BC_VARS_H                       &
                                       ,BC_VARS_V )
!
!-----------------------------------------------------------------------
!***  Extract variables for a nest's boundary from the datastring
!***  received by the child from its parent.  A child task might 
!***  receive segments of boundary data from two parent tasks in 
!***  which case the pieces are be combined.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: LENGTH_DATA                      &  !<-- # of words in datastring
                                      ,I_START                          &  !<-- Starting I of data segment in string on child's grid
                                      ,I_END                            &  !<-- Ending I of data segment in string on child's grid
                                      ,J_START                          &  !<-- Starting J of data segment in string on child's grid
                                      ,J_END                            &  !<-- Ending J of data segment in string on child's grid
                                      ,ILIM_LO                          &  !<-- Lower I limit of full boundary segment 
                                      ,ILIM_HI                          &  !<-- Upper I limit of full boundary segment 
                                      ,JLIM_LO                          &  !<-- Lower J limit of full boundary segment 
                                      ,JLIM_HI                             !<-- Upper J limit of full boundary segment 
!
      REAL(kind=KFPT),DIMENSION(:),INTENT(IN) :: DATASTRING                !<-- The string of boundary data from the parent
!      
      INTEGER(kind=KINT),INTENT(IN) :: NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                      ,NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                      ,NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                      ,NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                      ,NVARS_BC_3D_V                       !<-- # of 3-D V-pt vbls on child boundary
!      
      INTEGER(kind=KINT),DIMENSION(:),INTENT(IN) :: LBND_4D             &  !<-- Lower bounds of 4-D variables' 4th dimension
                                                   ,UBND_4D                !<-- Upper bounds of 4-D variables' 4th dimension
!      
      REAL(kind=KFPT),DIMENSION(ILIM_LO:ILIM_HI,JLIM_LO:JLIM_HI)        &
                                          ,INTENT(OUT),OPTIONAL :: PDB     !<-- PD for segment of the child boundary
!      
      TYPE(BC_H),INTENT(INOUT),OPTIONAL :: BC_VARS_H                       !<-- Child's 1-D segment of other H-pt vbls on bndry segment
!
      TYPE(BC_V),INTENT(INOUT),OPTIONAL :: BC_VARS_V                       !<-- Child's 1-D segment of V-pt vbls on bndry segment
!      
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,J,K,L,LB,N,NV,UB
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Extract the appropriate boundary variables from the datastring
!***  provided by the parent.
!***  Here we transfer from the 1-D string to the 2-D and 3-D arrays.
!***  This easily allows for proper combining of separate strings
!***  whose ends may overlap that are arriving from different parent
!***  tasks.  To export these boundary arrays out of the coupler
!***  though the data must be put back into 1-D.
!
!***  The 2-D pressure array PD is always the first variable in the
!***  datastring from the parent.  
!-----------------------------------------------------------------------
!
      N=0
!
      IF(PRESENT(BC_VARS_H))THEN                                           !<-- Parent datastring for H-pt variables has been sent in
!
        DO J=J_START,J_END
        DO I=I_START,I_END
          N=N+1
          PDB(I,J)=DATASTRING(N)                                           !<-- The 2-D PD array is handled separately
        ENDDO
        ENDDO
!
        IF(NVARS_BC_2D_H>1)THEN                                            !<-- Loop through remaining 2-D H-pt boundary variables
          DO NV=1,NVARS_BC_2D_H-1
            DO J=J_START,J_END
            DO I=I_START,I_END
              N=N+1
              BC_VARS_H%VAR_2D(NV)%SIDE(I,J)=DATASTRING(N)
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN                                            !<-- Loop through 3-D H-pt boundary variables
          DO NV=1,NVARS_BC_3D_H
            DO K=1,LM
            DO J=J_START,J_END
            DO I=I_START,I_END
              N=N+1
              BC_VARS_H%VAR_3D(NV)%SIDE(I,J,K)=DATASTRING(N)
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN                                            !<-- Loop through 3-D H-pt boundary variables
          DO NV=1,NVARS_BC_4D_H  
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            DO L=LB,UB
            DO K=1,LM
            DO J=J_START,J_END
            DO I=I_START,I_END
              N=N+1
              BC_VARS_H%VAR_4D(NV)%SIDE(I,J,K,L)=DATASTRING(N)
            ENDDO
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
      ELSEIF(PRESENT(BC_VARS_V))THEN                                       !<-- Parent datastring for V-pt variables has been sent in
!
        IF(NVARS_BC_2D_V>1)THEN                                            !<-- Loop through 2-D V-pt boundary variables
          DO NV=1,NVARS_BC_2D_V
            DO J=J_START,J_END
            DO I=I_START,I_END
              N=N+1
              BC_VARS_V%VAR_2D(NV)%SIDE(I,J)=DATASTRING(N)
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>1)THEN                                            !<-- Loop through all the 3-D V-pt boundary variables
          DO NV=1,NVARS_BC_3D_V
            DO K=1,LM
            DO J=J_START,J_END
            DO I=I_START,I_END
              N=N+1
              BC_VARS_V%VAR_3D(NV)%SIDE(I,J,K)=DATASTRING(N)
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHILD_DATA_FROM_STRING
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE EXPORT_CHILD_BOUNDARY(NVARS_BC_2D_H                    &
                                      ,NVARS_BC_3D_H                    &
                                      ,NVARS_BC_4D_H                    &
                                      ,LBND_4D                          &
                                      ,UBND_4D                          &
                                      ,NVARS_BC_2D_V                    &
                                      ,NVARS_BC_3D_V                    &
                                      ,PDB                              &
                                      ,BC_VARS_H                        &
                                      ,BC_VARS_V                        &
!
                                      ,ILIM_LO,ILIM_HI                  &
                                      ,JLIM_LO,JLIM_HI                  &
!
                                      ,DATA_NAME                        &
!
                                      ,DATA_EXP                         &
!
                                      ,EXPORT_STATE )
!
!-----------------------------------------------------------------------
!***  Load the child boundary values received from the parent 
!***  into the Parent-Child coupler export state.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: NVARS_BC_2D_H                    &  !<-- # of 2-D H-pt vbls on child boundary
                                      ,NVARS_BC_3D_H                    &  !<-- # of 3-D H-pt vbls on child boundary
                                      ,NVARS_BC_4D_H                    &  !<-- # of 4-D H-pt vbls on child boundary
                                      ,NVARS_BC_2D_V                    &  !<-- # of 2-D V-pt vbls on child boundary
                                      ,NVARS_BC_3D_V                       !<-- # of 3-D V-pt vbls on child boundary
!      
      INTEGER(kind=KINT),INTENT(IN) :: ILIM_LO                          &  !<-- Lower I limit of full boundary segment
                                      ,ILIM_HI                          &  !<-- Upper I limit of full boundary segment
                                      ,JLIM_LO                          &  !<-- Lower J limit of full boundary segment
                                      ,JLIM_HI                             !<-- Upper J limit of full boundary segment
!      
      INTEGER(kind=KINT),DIMENSION(:),INTENT(IN) :: LBND_4D             &  !<-- Lower bound of 4-D variables' 4th dimension
                                                   ,UBND_4D                !<-- Upper bound of 4-D variables' 4th dimension
!      
      REAL(kind=KFPT),DIMENSION(ILIM_LO:ILIM_HI,JLIM_LO:JLIM_HI)        &
                                           ,INTENT(IN),OPTIONAL :: PDB     !<-- PD for segment of the child boundary
!      
      TYPE(BC_H),INTENT(IN),OPTIONAL :: BC_VARS_H                          !<-- Child's 1-D segment of other H-pt vbls on bndry segment
!
      TYPE(BC_V),INTENT(IN),OPTIONAL :: BC_VARS_V                          !<-- Child's 1-D segment of V-pt vbls on bndry segment
!      
      CHARACTER(*),INTENT(IN) :: DATA_NAME                                 !<-- Name used for each child task's boundary segment
!
      REAL(kind=KFPT),DIMENSION(:),POINTER,INTENT(INOUT) :: DATA_EXP       !<-- Combined boundary segment data on child task
!
      TYPE(ESMF_State),INTENT(INOUT) :: EXPORT_STATE                       !<-- The Parent-Child Coupler export state
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,J,K,L,LB,NV,UB                            &
                           ,ISTAT,RC,RC_EXP_BNDRY
!
      INTEGER(kind=KINT),SAVE :: NN
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      RC          =ESMF_SUCCESS
      RC_EXP_BNDRY=ESMF_SUCCESS
!
!-----------------------------------------------------------------------
!***  The children's final boundary data will be loaded into the
!***  Parent-Child Coupler's export state as 1-D arrays (Attributes)
!***  since they are not spanning the childrens' ESMF Grids (as Fields).
!***  But because they are Attributes and not Fields, they will need
!***  to be reset every time.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
      main: IF(PRESENT(BC_VARS_H))THEN                                     !<-- If true then H-point variables were sent in
!-----------------------------------------------------------------------
!
        NN=0                                                               !<-- The data always begins with H points
!
        DO J=JLIM_LO,JLIM_HI
        DO I=ILIM_LO,ILIM_HI
          NN=NN+1
          DATA_EXP(NN)=PDB(I,J)                                            !<-- First insert complete PDB into the 1-D H boundary data
        ENDDO
        ENDDO
!
!
        IF(NVARS_BC_2D_H>1)THEN
          DO NV=1,NVARS_BC_2D_H-1
            DO J=JLIM_LO,JLIM_HI
            DO I=ILIM_LO,ILIM_HI
              NN=NN+1         
              DATA_EXP(NN)=BC_VARS_H%VAR_2D(NV)%SIDE(I,J)                  !<-- Insert 2-D H-pt BC vbls into the 1-D H boundary data
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            DO K=1,LM
            DO J=JLIM_LO,JLIM_HI
            DO I=ILIM_LO,ILIM_HI
              NN=NN+1         
              DATA_EXP(NN)=BC_VARS_H%VAR_3D(NV)%SIDE(I,J,K)                !<-- Insert 3-D H-pt BC vbls into the 1-D H boundary data
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            LB=LBND_4D(NV)
            UB=UBND_4D(NV)
            DO L=LB,UB
            DO K=1,LM
            DO J=JLIM_LO,JLIM_HI
            DO I=ILIM_LO,ILIM_HI
              NN=NN+1         
              DATA_EXP(NN)=BC_VARS_H%VAR_4D(NV)%SIDE(I,J,K,L)              !<-- Insert 4-D H-pt BC vbls into the 1-D H boundary data
            ENDDO
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry Data "//DATA_NAME//" Into Coupler Export"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =EXPORT_STATE                   &  !<-- This Parent_child Coupler export state
                              ,name     =DATA_NAME                      &  !<-- Name of the children's new boundary H data
                              ,itemCount=NN                             &  !<-- # of words in the data
                              ,valueList=DATA_EXP                       &  !<-- The children's new boundary H data
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_EXP_BNDRY)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      ELSEIF(PRESENT(BC_VARS_V))THEN                                       !<-- If true then V-point variables were sent in
!
!-----------------------------------------------------------------------
!
        NN=0
!
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            DO J=JLIM_LO,JLIM_HI
            DO I=ILIM_LO,ILIM_HI
              NN=NN+1
              DATA_EXP(NN)=BC_VARS_V%VAR_2D(NV)%SIDE(I,J)                  !<-- Insert 2-D V-pt BC vbls into the 1-D V boundary data
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            DO K=1,LM
            DO J=JLIM_LO,JLIM_HI
            DO I=ILIM_LO,ILIM_HI
              NN=NN+1
              DATA_EXP(NN)=BC_VARS_V%VAR_3D(NV)%SIDE(I,J,K)                !<-- Insert 3-D V-pt BC vbls into the 1-D V boundary data
            ENDDO
            ENDDO
            ENDDO
          ENDDO
        ENDIF
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Load Child Bndry Data "//DATA_NAME//" Into Coupler Export"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state    =EXPORT_STATE                    &  !<-- This Parent_child Coupler export state
                              ,name     =DATA_NAME                       &  !<-- Name of the children's new boundary V data
                              ,itemCount=NN                              &  !<-- # of words in the data
                              ,valueList=DATA_EXP                        &  !<-- The children's new boundary V data
                              ,rc       =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_EXP_BNDRY)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
      ENDIF main
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE EXPORT_CHILD_BOUNDARY
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE DEALLOC_WORK_PARENTS(N,TIME_FLAG)
!
!-----------------------------------------------------------------------
!***  Parents deallocate all working pointers that needed to be
!***  allocated with unique dimensions at the outset of the forecast 
!***  and again each time a nest moves.  Those allocations took place
!***  in subroutine POINT_INTERP_DATA_TO_MEMORY.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: N                                   !<-- Which child of this parent
!
      CHARACTER(*),INTENT(IN) :: TIME_FLAG                                 !<-- Current or future boundary data for children?
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: IERR,INDX2,ISTAT,NCHILD_TASKS,NMAX,NT,NV
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Select the appropriate part of the working array depending on
!***  whether we are now concerned with children's boundaries for
!***  their current time or for their future.
!-----------------------------------------------------------------------
!
      IF(TIME_FLAG=='Future')THEN
        INDX2=1
      ELSEIF(TIME_FLAG=='Current')THEN
        INDX2=2
      ENDIF
!
!-----------------------------------------------------------------------
!***  The parent must not deallocate the actual BC update buffers
!***  until it knows that they have been Recvd by the children.
!***  That is the reason for the Waits below.
!-----------------------------------------------------------------------
!
!-----------
!***  South
!-----------
!
      NMAX=UBOUND(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      south_h: IF(ASSOCIATED(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS,1)          !<-- # of Sbndry tasks on child N that recvd H point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_H_SOUTH(N,INDX2)%TASKS,stat=ISTAT)
!
        IF(ASSOCIATED(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_H_SOUTH(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF south_h
!
      NCHILD_TASKS=UBOUND(PD_B_SOUTH(N)%TASKS,1)                           !<-- # of Sbndry tasks on child N that recvd H point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_SOUTH(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_SOUTH(N)%TASKS(NT)%DATA)
        ENDIF
        DEALLOCATE(FIS_CHILD_SOUTH(N)%TASKS(NT)%DATA)
      ENDDO
!
      DEALLOCATE(PD_B_SOUTH(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_H-1
        DEALLOCATE(BND_VAR_H_SOUTH(NV)%CHILD(N)%TASKS,stat=ISTAT)
        IF(ISTAT>0)THEN
          WRITE(0,11011)NV,N,ISTAT
11011     FORMAT(' DEALLOC_WORK_PARENTS failed to deallocate'          &
                ,' BND_VAR_H_SOUTH(',I2,')%CHILD(',I2,')%TASKS'        &
                ,' ISTAT=',I4)
        ENDIF
      ENDDO
!
      DEALLOCATE(FIS_CHILD_SOUTH(N)%TASKS)
      DEALLOCATE(WORDS_BOUND_H_SOUTH(N)%TASKS)
!
      NMAX=UBOUND(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      south_v: IF(ASSOCIATED(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS,1)          !<-- # of Sbndry tasks on child N that recvd V point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_V_SOUTH(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_V_SOUTH(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF south_v
!
      NCHILD_TASKS=UBOUND(PD_B_SOUTH_V(N)%TASKS,1)                         !<-- # of Sbndry tasks on child N that recvd V point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_SOUTH_V(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_SOUTH_V(N)%TASKS(NT)%DATA)
        ENDIF
      ENDDO
!
      DEALLOCATE(WORDS_BOUND_V_SOUTH(N)%TASKS)
      DEALLOCATE(PD_B_SOUTH_V(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_V
        DEALLOCATE(BND_VAR_V_SOUTH(NV)%CHILD(N)%TASKS)
      ENDDO
!
!-----------------------------------------------------------------------
!
!-----------
!***  North
!-----------
!
      NMAX=UBOUND(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      north_h: IF(ASSOCIATED(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS,1)          !<-- # of Nbndry tasks on child N that recvd H point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA,stat=ISTAT)
            IF(ISTAT/=0)THEN
              WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
                       ,' Failed to deallocate CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA'
            ELSE
!             WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
!                      ,' Succeeded in deallocating CHILD_BOUND_H_NORTH(N,INDX2)%TASKS(NT)%DATA'
            ENDIF
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_H_NORTH(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_H_NORTH(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF north_h
!
      NCHILD_TASKS=UBOUND(PD_B_NORTH(N)%TASKS,1)                           !<-- # of Nbndry tasks on child N that recvd H point data
!
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_NORTH(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_NORTH(N)%TASKS(NT)%DATA,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
                     ,' Failed to deallocate PD_B_NORTH(N)%TASKS(NT)%DATA'
          ELSE
!           WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
!                    ,' Succeeded in deallocating PD_B_NORTH(N)%TASKS(NT)%DATA'
          ENDIF
        ENDIF
        DEALLOCATE(FIS_CHILD_NORTH(N)%TASKS(NT)%DATA)
      ENDDO
!
      DEALLOCATE(PD_B_NORTH(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_H-1
        DEALLOCATE(BND_VAR_H_NORTH(NV)%CHILD(N)%TASKS)
      ENDDO
!
      DEALLOCATE(FIS_CHILD_NORTH(N)%TASKS)
      DEALLOCATE(WORDS_BOUND_H_NORTH(N)%TASKS)
!
      NMAX=UBOUND(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV(NT)      &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      north_v: IF(ASSOCIATED(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS,1)          !<-- # of Nbndry tasks on child N that recvd V point data
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA         &
                                                           ,stat=ISTAT)
            IF(ISTAT/=0)THEN
              WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
                       ,' Failed to deallocate CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA'
            ELSE
!             WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
!                      ,' Succeeded in deallocating CHILD_BOUND_V_NORTH(N,INDX2)%TASKS(NT)%DATA'
            ENDIF
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_V_NORTH(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_V_NORTH(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF north_v
!
      NCHILD_TASKS=UBOUND(PD_B_NORTH_V(N)%TASKS,1)                         !<-- # of Nbndry tasks on child N that recvd V point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_NORTH_V(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_NORTH_V(N)%TASKS(NT)%DATA,stat=ISTAT)
          IF(ISTAT/=0)THEN
            WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
                     ,' Failed to deallocate PD_B_NORTH_V(N)%TASKS(NT)%DATA'
          ELSE
!           WRITE(0,*)' DEALLOC_WORK_PARENTS N=',N,' NT=',NT,' INDX2=',INDX2 &
!                    ,' Succeeded in deallocating PD_B_NORTH_V(N)%TASKS(NT)%DATA'
          ENDIF
        ENDIF
      ENDDO
!
      DEALLOCATE(WORDS_BOUND_V_NORTH(N)%TASKS)
      DEALLOCATE(PD_B_NORTH_V(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_V
        DEALLOCATE(BND_VAR_V_NORTH(NV)%CHILD(N)%TASKS)
      ENDDO
!
!-----------------------------------------------------------------------
!
!----------
!***  West
!----------
!
      NMAX=UBOUND(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      west_h: IF(ASSOCIATED(CHILD_BOUND_H_WEST(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_H_WEST(N,INDX2)%TASKS,1)           !<-- # of Wbndry tasks on child N that recvd H point data
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_H_WEST(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_H_WEST(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF west_h
!
      NCHILD_TASKS=UBOUND(PD_B_WEST(N)%TASKS,1)                            !<-- # of Wbndry tasks on child N that recvd H point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_WEST(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_WEST(N)%TASKS(NT)%DATA)
        ENDIF
        DEALLOCATE(FIS_CHILD_WEST(N)%TASKS(NT)%DATA)
      ENDDO
!
      DEALLOCATE(PD_B_WEST(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_H-1
        DEALLOCATE(BND_VAR_H_WEST(NV)%CHILD(N)%TASKS)
      ENDDO
!
      DEALLOCATE(FIS_CHILD_WEST(N)%TASKS)
      DEALLOCATE(WORDS_BOUND_H_WEST(N)%TASKS)
!
      NMAX=UBOUND(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      west_v: IF(ASSOCIATED(CHILD_BOUND_V_WEST(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_V_WEST(N,INDX2)%TASKS,1)           !<-- # of Wbndry tasks on child N that recvd V point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_V_WEST(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_V_WEST(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF west_v
!
      NCHILD_TASKS=UBOUND(PD_B_WEST_V(N)%TASKS,1)                          !<-- # of Wbndry tasks on child N that recvd V point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_WEST_V(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_WEST_V(N)%TASKS(NT)%DATA)
        ENDIF
      ENDDO
!
      DEALLOCATE(WORDS_BOUND_V_WEST(N)%TASKS)
      DEALLOCATE(PD_B_WEST_V(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_V
        DEALLOCATE(BND_VAR_V_WEST(NV)%CHILD(N)%TASKS)
      ENDDO
!
!-----------------------------------------------------------------------
!
!----------
!***  East
!----------
!
      NMAX=UBOUND(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      east_h: IF(ASSOCIATED(CHILD_BOUND_H_EAST(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_H_EAST(N,INDX2)%TASKS,1)           !<-- # of Ebndry tasks on child N that recvd H point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_H_EAST(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_H_EAST(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF east_h
!
      NCHILD_TASKS=UBOUND(PD_B_EAST(N)%TASKS,1)                            !<-- # of Ebndry tasks on child N that recvd H point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_EAST(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_EAST(N)%TASKS(NT)%DATA)
        ENDIF
        DEALLOCATE(FIS_CHILD_EAST(N)%TASKS(NT)%DATA)
      ENDDO
!
      DEALLOCATE(PD_B_EAST(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_H-1
        DEALLOCATE(BND_VAR_H_EAST(NV)%CHILD(N)%TASKS)
      ENDDO
!
      DEALLOCATE(FIS_CHILD_EAST(N)%TASKS)
      DEALLOCATE(WORDS_BOUND_H_EAST(N)%TASKS)
!
      NMAX=UBOUND(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV,1)
      IF(NMAX>0)THEN
        DO NT=1,NMAX
          CALL MPI_WAIT(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV(NT)       &  !<-- Handle for ISend from parent task to child N's task NT
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDDO
      ENDIF
!
      east_v: IF(ASSOCIATED(CHILD_BOUND_V_EAST(N,INDX2)%TASKS))THEN
!
        NCHILD_TASKS=UBOUND(CHILD_BOUND_V_EAST(N,INDX2)%TASKS,1)           !<-- # of Ebndry tasks on child N that recvd V point data
!
        DO NT=1,NCHILD_TASKS
          IF(ASSOCIATED(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA))THEN
            DEALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS(NT)%DATA)
          ENDIF
        ENDDO
!
        DEALLOCATE(CHILD_BOUND_V_EAST(N,INDX2)%TASKS)
!
        IF(ASSOCIATED(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV))THEN
          DEALLOCATE(HANDLE_V_EAST(N,INDX2)%NTASKS_TO_RECV)
        ENDIF
!
      ENDIF east_v
!
      NCHILD_TASKS=UBOUND(PD_B_EAST_V(N)%TASKS,1)                          !<-- # of Ebndry tasks on child N that recvd V point data
      DO NT=1,NCHILD_TASKS
        IF(ASSOCIATED(PD_B_EAST_V(N)%TASKS(NT)%DATA))THEN
          DEALLOCATE(PD_B_EAST_V(N)%TASKS(NT)%DATA)
        ENDIF
      ENDDO
!
      DEALLOCATE(WORDS_BOUND_V_EAST(N)%TASKS)
      DEALLOCATE(PD_B_EAST_V(N)%TASKS)
!
      DO NV=1,NVARS_NESTBC_V
        DEALLOCATE(BND_VAR_V_EAST(NV)%CHILD(N)%TASKS)
      ENDDO
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE DEALLOC_WORK_PARENTS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE DEALLOC_WORK_CHILDREN(MY_DOMAIN_ID)
!
!-----------------------------------------------------------------------
!***  Children deallocate all working pointers that need to be allocated 
!***  with unique dimensions at the outset of the forecast and again
!***  each time a nest moves.  These allocations took place in
!***  subroutine CHILD_RECVS_CHILD_DATA_LIMITS.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: MY_DOMAIN_ID                        !<-- The current domain's ID
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: ID_DOM,LIM_HI,N,NV
!
      TYPE(COMPOSITE),POINTER :: CC
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      CALL POINT_TO_COMPOSITE(MY_DOMAIN_ID)
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)
!
      ID_DOM=ID_PARENTS(MY_DOMAIN_ID)                                      !<-- Domain ID of this child's parent
      LIM_HI=FTASKS_DOMAIN(ID_DOM)                                         !<-- # of fcst tasks on this nest's parent domain
!
      DO N=1,LIM_HI
        IF(ALLOCATED(PARENT_TASK(N)%SOUTH_H%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%SOUTH_H%STRING)                        !<-- Sboundary H datastring from parent 'N'
        ENDIF
        IF(ALLOCATED(PARENT_TASK(N)%SOUTH_V%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%SOUTH_V%STRING)                        !<-- Sboundary V datastring from parent 'N'
        ENDIF
!
        IF(ALLOCATED(PARENT_TASK(N)%NORTH_H%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%NORTH_H%STRING)                        !<-- Nboundary H datastring from parent 'N'
        ENDIF
        IF(ALLOCATED(PARENT_TASK(N)%NORTH_V%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%NORTH_V%STRING)                        !<-- Nboundary V datastring from parent 'N'
        ENDIF
!
        IF(ALLOCATED(PARENT_TASK(N)%WEST_H%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%WEST_H%STRING)                         !<-- Wboundary H datastring from parent 'N'
        ENDIF
        IF(ALLOCATED(PARENT_TASK(N)%WEST_V%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%WEST_V%STRING)                         !<-- Wboundary V datastring from parent 'N'
        ENDIF
!
        IF(ALLOCATED(PARENT_TASK(N)%EAST_H%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%EAST_H%STRING)                         !<-- Eboundary H datastring from parent 'N'
        ENDIF
        IF(ALLOCATED(PARENT_TASK(N)%EAST_V%STRING))THEN
          DEALLOCATE(PARENT_TASK(N)%EAST_V%STRING)                         !<-- Eboundary V datastring from parent 'N'
        ENDIF
!
      ENDDO
!
      IF(NUM_PARENT_TASKS_SENDING_H%SOUTH>0)THEN                           !<-- Did this child task recv Sboundary H data from parent?
        IF(NVARS_BC_2D_H>0)THEN
          DO NV=1,NVARS_BC_2D_H-1
            DEALLOCATE(MY_BC_VARS_H_S%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            DEALLOCATE(MY_BC_VARS_H_S%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            DEALLOCATE(MY_BC_VARS_H_S%VAR_4D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%PDB_S)
        DEALLOCATE(cc%BOUND_1D_SOUTH_H)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_V%SOUTH>0)THEN                           !<-- Did this child task recv Sboundary V data from parent?
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            DEALLOCATE(MY_BC_VARS_V_S%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            DEALLOCATE(MY_BC_VARS_V_S%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%BOUND_1D_SOUTH_V)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_H%NORTH>0)THEN                           !<-- Did this child task recv Nboundary H data from parent?
        IF(NVARS_BC_2D_H>0)THEN
          DO NV=1,NVARS_BC_2D_H-1
            DEALLOCATE(MY_BC_VARS_H_N%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            DEALLOCATE(MY_BC_VARS_H_N%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            DEALLOCATE(MY_BC_VARS_H_N%VAR_4D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%BOUND_1D_NORTH_H)
        DEALLOCATE(cc%PDB_N)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_V%NORTH>0)THEN                           !<-- Did this child task recv Nboundary V data from parent?
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            DEALLOCATE(MY_BC_VARS_V_N%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            DEALLOCATE(MY_BC_VARS_V_N%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%BOUND_1D_NORTH_V)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_H%WEST>0)THEN                            !<-- Did this child task recv Wboundary H data from parent?
        IF(NVARS_BC_2D_H>0)THEN
          DO NV=1,NVARS_BC_2D_H-1
            DEALLOCATE(MY_BC_VARS_H_W%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            DEALLOCATE(MY_BC_VARS_H_W%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            DEALLOCATE(MY_BC_VARS_H_W%VAR_4D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%PDB_W)
        DEALLOCATE(cc%BOUND_1D_WEST_H)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_V%WEST>0)THEN                            !<-- Did this child task recv Wboundary V data from parent?
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            DEALLOCATE(MY_BC_VARS_V_W%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            DEALLOCATE(MY_BC_VARS_V_W%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%BOUND_1D_WEST_V)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_H%EAST>0)THEN                            !<-- Did this child task recv Eboundary H data from parent?
        IF(NVARS_BC_2D_H>0)THEN
          DO NV=1,NVARS_BC_2D_H-1
            DEALLOCATE(MY_BC_VARS_H_E%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_H>0)THEN
          DO NV=1,NVARS_BC_3D_H
            DEALLOCATE(MY_BC_VARS_H_E%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_4D_H>0)THEN
          DO NV=1,NVARS_BC_4D_H
            DEALLOCATE(MY_BC_VARS_H_E%VAR_4D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%PDB_E)
        DEALLOCATE(cc%BOUND_1D_EAST_H)
      ENDIF
!
      IF(NUM_PARENT_TASKS_SENDING_V%EAST>0)THEN                            !<-- Did this child task recv Eboundary V data from parent?
        IF(NVARS_BC_2D_V>0)THEN
          DO NV=1,NVARS_BC_2D_V
            DEALLOCATE(MY_BC_VARS_V_E%VAR_2D(NV)%SIDE)
          ENDDO
        ENDIF
        IF(NVARS_BC_3D_V>0)THEN
          DO NV=1,NVARS_BC_3D_V
            DEALLOCATE(MY_BC_VARS_V_E%VAR_3D(NV)%SIDE)
          ENDDO
        ENDIF
        DEALLOCATE(cc%BOUND_1D_EAST_V)
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE DEALLOC_WORK_CHILDREN
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE COMPUTE_STORM_MOTION(NTIMESTEP                         &
                                     ,LAST_STEP_MOVED                   &
                                     ,DT                                &
                                     ,NUM_PES_FCST                      &
                                     ,COMM_FCST_TASKS                   &
                                     ,FIS                               &
                                     ,PD                                &
                                     ,PINT                              &
                                     ,T                                 &
                                     ,Q                                 &
                                     ,CW                                &
                                     ,U                                 &
                                     ,V                                 &
                                     ,DSG2                              &
                                     ,PDSG1                             &
                                     ,DX,DY                             &
                                     ,SEA_MASK                          &
                                     ,I_SW_PARENT_CURRENT               &
                                     ,J_SW_PARENT_CURRENT               &
                                     ,I_WANT_TO_MOVE                    &
                                     ,I_SW_PARENT_NEW                   &
                                     ,J_SW_PARENT_NEW                   &
                                     ,MY_DOMAIN_ID )
!
!-----------------------------------------------------------------------
!***  The nest computes the location of the center of the storm
!***  on its grid and decides if it should move.  This routine
!***  is called at the end of each timestep.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables   
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: COMM_FCST_TASKS                  &  !<-- Intracommunicator for domain's forecast tasks
                                      ,I_SW_PARENT_CURRENT              &  !<-- Parent I of nest domain's SW corner; current position
                                      ,J_SW_PARENT_CURRENT              &  !<-- Parent J of nest domain's SW corner; current position
                                      ,LAST_STEP_MOVED                  &  !<-- Most recent timestep the nest moved
                                      ,MY_DOMAIN_ID                     &  !<-- This domain's ID
                                      ,NTIMESTEP                        &  !<-- The nest's current timestep
                                      ,NUM_PES_FCST                        !<-- # of forecast tasks
!
      INTEGER(kind=KINT),INTENT(OUT) :: I_SW_PARENT_NEW                 &  !<-- Parent I of nest domain's SW corner; new position
                                       ,J_SW_PARENT_NEW                    !<-- Parent J of nest domain's SW corner; new position
!
      REAL(kind=KFPT),INTENT(IN) :: DT                                  &  !<-- This domain's timestep
                                   ,DY                                     !<-- Delta Y (m) on the nest grid
!
      REAL(kind=KFPT),DIMENSION(JDS:JDE),INTENT(IN) :: DX                  !<-- Delta X (m) on the nest grid
!
      REAL(kind=KFPT),DIMENSION(1:LM),INTENT(IN) :: DSG2,PDSG1
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS      &  !<-- Sfc geopotential (m2/s2)
                                                              ,PD       &  !<-- Psfc minus PTOP (Pa)
                                                              ,SEA_MASK    !<-- Sea mask (1->water)
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: CW  &  !<-- Cloud condensate (kg/kg)
                                                                   ,Q   &  !<-- Specific humidity (kg/kg)
                                                                   ,T   &  !<-- Sensible temperature (K)
                                                                   ,U   &  !<-- U component of wind (m/s)
                                                                   ,V      !<-- V component of wind (m/s)
!
      REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM+1),INTENT(IN) ::   &
                                                                   PINT    !<-- Layer interface pressures (Pa)
!
      LOGICAL(kind=KLOG),INTENT(OUT) :: I_WANT_TO_MOVE                     !<-- Does nest want to move to a new position?
!
!---------------------
!***  Local Variables
!---------------------
!
!     INTEGER(kind=KINT),SAVE :: I_EAST,I_WEST                          &  !<-- These define the nest domain search limits
!                               ,J_NORTH,J_SOUTH                           !    within the central window.
!
      INTEGER(kind=KINT),SAVE :: ID_DUMMY=-999                          &  !<-- Dummy value for task ID
                                ,ITAG_PG=200                               !<-- Hardwire this tag for Sends/Recvs of Pgrad values
!
!     INTEGER(kind=KINT),SAVE :: I_MAX,I_MIN                            &
!                               ,J_MAX,J_MIN                            &
!                               ,NPTS_NS,NPTS_WE
!
      INTEGER(kind=KINT) :: I,I_CENTER_CURRENT,I_CENTER_NEW             &
                           ,I_DIFF,ID_PE_MIN                            &
                           ,J,J_CENTER_CURRENT,J_CENTER_NEW             &
                           ,J_DIFF                                      &
                           ,L,L1,L2,L3,MYPE_DOM,N,N_SEND
!
      INTEGER(kind=KINT) :: IERR,ISTAT
!
!     INTEGER(kind=KINT),DIMENSION(1:4),SAVE :: I_PG,J_PG
!
      INTEGER(kind=KINT),DIMENSION(1:4) :: HANDLE_PVAL
!
      INTEGER(kind=KINT),DIMENSION(0:NUM_PES_FCST-1) :: HANDLE_PDYN     &
                                                       ,HANDLE_WIN
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      REAL(kind=KFPT),SAVE :: DIST_GRAD=100000.                         &  !<-- Distance (m) for checking storm-scale pressure gradient
                             ,DIST_LAND=100000.                         &  !<-- Distance (m) for checking shift over land
                             ,ELAPSED_TIME_MAX=30000.                   &  !<-- Maximum time (sec) between nest shifts over land
                             ,GI=1./G                                   & 
                             ,PGRD_MIN=200.                             &  !<-- Minimum storm scale pressure gradient (Pa)
                             ,PGRD_MIN_LAND=400.                        &  !<-- Minimum storm scale pressure gradient (Pa) over land
                             ,STD_LAPSE=6.5E-3                          &  !<-- Standard atmospheric lapse rate
                             ,THIRD=1./3.                               &
                             ,Z1=2000.                                  &  !<-- In computing the dynamic pressure use the winds
                             ,Z2=1500.                                  &  !    at around 2km, 1.5km and 1km.
                             ,Z3=1000.                                     !<--
!
!     REAL(kind=KFPT),SAVE :: COEF                                      &
!                            ,ELAPSED_TIME_MIN                          &
!                            ,RNPTS_HZ
!
      REAL(kind=KFPT) :: APELP,DFDP,DIST_I,DIST_J,DZ                    &
                        ,ELAPSED_TIME,FACTOR,FRAC_SEA                   &
                        ,PARENT_DIFF,PCHECK                             &
                        ,PDYN_MIN_GBL,PMAX,PVAL,PVAL_N                  &
                        ,SLP_MIN,SQWS,SUM_SEA,TSFC                      &
                        ,ZDIFF,ZLOW,ZSAVE1,ZSAVE2,ZSAVE3
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: PDYN_MIN_VALS                !<-- Minimum PDYN on each task subdomain
!
      REAL(kind=KFPT),DIMENSION(1:3,0:NUM_PES_FCST-1),TARGET ::         &
                                                             PDYN_MIN      !<-- Minimum PDYN and its I,J on each nest task subdomain
!
      REAL(kind=KFPT),DIMENSION(1:LM) :: ZMEAN
!
      REAL(kind=KFPT),DIMENSION(ITS:ITE,JTS:JTE) :: PDYN,SLP
!
      REAL(kind=KFPT),DIMENSION(ITS:ITE,JTS:JTE,1:LM+1) :: Z
!
!     LOGICAL(kind=KLOG),SAVE :: FIRST_PASS=.TRUE.                      &
!                               ,I_HOLD_CENTER_POINT
!
!     LOGICAL(kind=KLOG),DIMENSION(:),ALLOCATABLE,SAVE :: IN_WINDOW
!
      LOGICAL(kind=KLOG),DIMENSION(1:4) :: NO_VALUE
!
!     LOGICAL(kind=KLOG),DIMENSION(1:4),SAVE :: I_HOLD_PG_POINT
!
      TYPE(COMPOSITE),POINTER :: CC                                     
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      CC=>CPL_COMPOSITE(MY_DOMAIN_ID)                                      !<-- Use dummy for shorter reference to composite
!
      CALL MPI_COMM_RANK(COMM_FCST_TASKS,MYPE_DOM,IERR)                    !<-- Task's local rank on this domain
!
      I_WANT_TO_MOVE=.FALSE.                                               !<-- Begin with this assumption
!
!-----------------------------------------------------------------------
!
      I_CENTER_CURRENT=IDS+INT(0.5*(IDE-IDS)+EPS)     
      J_CENTER_CURRENT=JDS+INT(0.5*(JDE-JDS)+EPS)    
!
!-----------------------------------------------------------------------
!***  In the first pass through this routine the nest tasks
!***  determine which of their subdomains contain points within
!***  the nest domain's central search window over the storm.  Then
!***  they exchange that information with each other.
!-----------------------------------------------------------------------
!
      prelim: IF(FIRST_PASS_M)THEN                                         !<-- Work needs to be done only once during the forecast
!
!-----------------------------------------------------------------------
!
        FIRST_PASS_M=.FALSE.
!
        I_WEST_M =IDE/2-IDE/3                                              !<-- These define the nest domain search limits
        I_EAST_M =IDE/2+IDE/3                                              !    within the central window.
        J_SOUTH_M=JDE/2-JDE/3                                              !
        J_NORTH_M=JDE/2+JDE/3                                              !<--
!
        IF(.NOT.ASSOCIATED(cc%IN_WINDOW))THEN
          ALLOCATE(cc%IN_WINDOW(0:NUM_PES_FCST-1),stat=ISTAT)              !<-- Must be allocated since 0:NUM_PES_FCST is passed in
          IF(ISTAT/=0)THEN
            WRITE(0,*)' COMPUTE_STORM_MOTION: ERROR'
            WRITE(0,*)' Failed to allocate IN_WINDOW stat=',ISTAT
          ENDIF
        ENDIF
!
        IN_WINDOW=>cc%IN_WINDOW
        IN_WINDOW(MYPE_DOM)=.FALSE.
!
        IF(ITS<=I_EAST_M.AND.ITE>=I_WEST_M                              &  !<-- Does any of nest task N's subdomain
                      .AND.                                             &  !    lie within the central window?
           JTS<=J_NORTH_M.AND.JTE>=J_SOUTH_M)THEN
!
          IN_WINDOW(MYPE_DOM)=.TRUE.                                       !<-- Yes, this task lies in the search window
!
          I_MIN=MAX(ITS,I_WEST_M)                                          !<-- Index limits of this task's subdomain
          I_MAX=MIN(ITE,I_EAST_M)                                          !    that lie inside the search window.
          J_MIN=MAX(JTS,J_SOUTH_M)                                         !
          J_MAX=MIN(JTE,J_NORTH_M)                                         !<--
!
          RNPTS_HZ=1./REAL((I_MAX-I_MIN+1)*(J_MAX-J_MIN+1))                !<-- Reciprocal of # of task's points in search window
!
        ENDIF
!
        DO N=0,NUM_PES_FCST-1                                              !<-- Nest fcst tasks send their window status to each other
          IF(N/=MYPE_DOM)THEN                                              !<-- But not to themselves
            CALL MPI_ISSEND(IN_WINDOW(MYPE_DOM)                         &  !<-- This task's central window status
                           ,1                                           &  !<-- Sending this many words
                           ,MPI_LOGICAL                                 &  !<-- Datatype
                           ,N                                           &  !<-- Sending to this local nest task ID
                           ,MYPE_DOM                                    &  !<-- Use this task's ID as the tag
                           ,COMM_FCST_TASKS                             &  !<-- Intracommunicator for fcst tasks
                           ,HANDLE_WIN(N)                               &  !<-- Communication request handle for task N's Recv
                           ,IERR )
          ENDIF
        ENDDO
!
        DO N=0,NUM_PES_FCST-1                                              !<-- Nest fcst tasks recv window status from each other
          IF(N/=MYPE_DOM)THEN                                              !<-- But not from themselves
            CALL MPI_RECV(IN_WINDOW(N)                                  &  !<-- Nest task N's central window status
                         ,1                                             &  !<-- Receiving this many words
                         ,MPI_LOGICAL                                   &  !<-- Datatype
                         ,N                                             &  !<-- Data was sent by this nest task
                         ,N                                             &  !<-- Tag is the sender's rank
                         ,COMM_FCST_TASKS                               &  !<-- Intracommunicator for fcst tasks
                         ,JSTAT                                         &  !<-- MPI status
                         ,IERR )
          ENDIF
        ENDDO
!
        DO N=0,NUM_PES_FCST-1
          IF(N/=MYPE_DOM)THEN   
            CALL MPI_WAIT(HANDLE_WIN(N)                                 &  !<-- Proceed only after all ISSends have completed
                         ,JSTAT                                         & 
                         ,IERR )
          ENDIF
        ENDDO
!
!-----------------------------------------------------------------------
!***  We will need an approximation of the maximum pressure gradient 
!***  around the storm center.  Use SLP values roughly DIST_GRAD meters
!***  N, S, W, and E of the center.  What is the relative distance
!***  in gridpoints that this distance represents?
!-----------------------------------------------------------------------
!
        NPTS_NS=NINT(DIST_GRAD/DY)                                         !<-- # grid points to N/S of center to check SLP
        NPTS_WE=NINT(DIST_GRAD/DX(J_CENTER_CURRENT))                       !<-- # grid points to W/E of center to check SLP
!
!-----------------------------------------------------------------------
!
        COEF=-G/(R_D*STD_LAPSE)
!
!-----------------------------------------------------------------------
!***  Set the minimum time between domain shifts.  For now make it a
!***  linear relationship where the 9km nest must wait at least 15 min
!***  to move.
!-----------------------------------------------------------------------
!
        ELAPSED_TIME_MIN=45.*DT                                            !<-- Equals 900s for a 9 km nest.
!
!-----------------------------------------------------------------------
!***  Allow the minimum pressure gradient between the storm center
!***  and the cardinal points to be smaller for higher resolution.
!-----------------------------------------------------------------------
!
        IF(DY<8999.)THEN
          PGRD_MIN=PGRD_MIN*DY/9000.
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF prelim
!
!-----------------------------------------------------------------------
!***  Allow the nest to move only in one of its physics timesteps.
!-----------------------------------------------------------------------
!
      IF(MOD(NTIMESTEP,NPHS)/=0)THEN
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  Never let the nest move until a minimum amount of time
!***  has passed.
!-----------------------------------------------------------------------
!
      ELAPSED_TIME=(NTIMESTEP-LAST_STEP_MOVED)*DT
!
      IF(ELAPSED_TIME<ELAPSED_TIME_MIN)THEN
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  What fraction of the entire nest domain is now over water?
!-----------------------------------------------------------------------
!
      SUM_SEA=0.
!
      DO J=JTS,JTE
      DO I=ITS,ITE
        SUM_SEA=SUM_SEA+SEA_MASK(I,J)
      ENDDO
      ENDDO
!
      CALL MPI_ALLREDUCE(SUM_SEA                                        &  !<-- The value on each task
                        ,FRAC_SEA                                       &  !<-- The final value on all tasks
                        ,1                                              &  !<-- Operating on single words
                        ,MPI_REAL                                       &  !<-- Datatype
                        ,MPI_SUM                                        &  !<-- Sum all the values
                        ,COMM_FCST_TASKS                                &  !<-- Intracommunicator for fcst tasks
                        ,IERR )
!
      FRAC_SEA=FRAC_SEA/(IDE*JDE)
!
!-----------------------------------------------------------------------
!***  Do not consider moving if the storm has been stationary 
!***  too long over land.
!-----------------------------------------------------------------------
!
      IF(FRAC_SEA<=0.2.AND.ELAPSED_TIME>ELAPSED_TIME_MAX)THEN
        IF(MYPE_DOM==0)THEN
          WRITE(0,*)' SKIP MOTION COMPUTATION:  Storm stationary over land.'
        ENDIF
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!
      DO N=0,NUM_PES_FCST-1
        PDYN_MIN(1,N)=110000.                                              !<-- Initialize the minimum value of PDYN.
        PDYN_MIN(2,N)=-1000.                                               !<-- Initialize the I index of minimum PDYN
        PDYN_MIN(3,N)=-1000.                                               !<-- Initialize the J index of minimum PDYN
      ENDDO
!
      DO J=JTS,JTE
      DO I=ITS,ITE
        SLP(I,J)=0.                                                        !<-- Initialize the SLP array.
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!***  Begin the search for the new storm center location.
!***  Search inside the central window.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
      window: IF(IN_WINDOW(MYPE_DOM))THEN                                  !<-- Only those tasks within the search window proceed
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Compute a 'dynamic pressure' using vertically averaged winds
!***  around Z1, Z2, and Z3 meters as well as the sea level pressure.
!-----------------------------------------------------------------------
!
        DO J=J_MIN,J_MAX
        DO I=I_MIN,I_MAX
          Z(I,J,LM+1)=FIS(I,J)*GI                                          !<-- The surface elevation (m)
        ENDDO
        ENDDO
!
        DO L=LM,1,-1
          ZMEAN(L)=0.
          DO J=J_MIN,J_MAX
          DO I=I_MIN,I_MAX
            APELP=(PINT(I,J,L)+PINT(I,J,L+1))*0.5
            DFDP=(Q(I,J,L)*P608+(1.-CW(I,J,L)))*T(I,J,L)*R_D/APELP
            DZ=GI*DFDP*(DSG2(L)*PD(I,J)+PDSG1(L))
            Z(I,J,L)=Z(I,J,L+1)+DZ
            ZMEAN(L)=ZMEAN(L)+0.5*(Z(I,J,L)+Z(I,J,L+1))
          ENDDO
          ENDDO
          ZMEAN(L)=ZMEAN(L)*RNPTS_HZ                                       !<-- The mean height (m) of midlayer L in search window
        ENDDO
!
        ZSAVE1=1.E10
        ZSAVE2=1.E10
        ZSAVE3=1.E10
!
!-----------------------------------------------------------------------
!***  Find and save the model midlayer indices nearest to the 
!***  prescribed heights of Z1, Z2, and Z3 meters above the ground.
!-----------------------------------------------------------------------
!
        DO L=1,LM
!
          ZDIFF=ABS(ZMEAN(L)-Z1)
          IF(ZDIFF<ZSAVE1)THEN
            ZSAVE1=ZDIFF
            L1=L
          ENDIF
!
          ZDIFF=ABS(ZMEAN(L)-Z2)
          IF(ZDIFF<ZSAVE2)THEN
            ZSAVE2=ZDIFF
            L2=L
          ENDIF
!
          ZDIFF=ABS(ZMEAN(L)-Z3)
          IF(ZDIFF<ZSAVE3)THEN
            ZSAVE3=ZDIFF
            L3=L
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Compute a 'dynamic pressure' using the sea level pressure
!***  and the winds nearest the heights Z1, Z2, and Z3.
!-----------------------------------------------------------------------
!
        DO J=J_MIN,J_MAX
        DO I=I_MIN,I_MAX
          ZLOW=0.5*(Z(I,J,LM)+Z(I,J,LM+1))                                 !<-- Height of lowest midlayer
          TSFC=T(I,J,LM)*(Q(I,J,LM)*P608+(1.-CW(I,J,LM)))+STD_LAPSE*ZLOW   !<-- Representative sfc T
          FACTOR=STD_LAPSE*Z(I,J,LM+1)/TSFC
          SLP(I,J)=PINT(I,J,LM+1)*(1.-FACTOR)**COEF
          SQWS=(U(I,J,L1)*U(I,J,L1)+V(I,J,L1)*V(I,J,L1)                 &
               +U(I,J,L2)*U(I,J,L2)+V(I,J,L2)*V(I,J,L2)                 &
               +U(I,J,L3)*U(I,J,L3)+V(I,J,L3)*V(I,J,L3))*THIRD
!         PDYN(I,J)=SLP(I,J)+0.55*SQWS
!
          PDYN(I,J)=SLP(I,J)                                               !<-- FOR NOW, set PDYN to the sea level pressure
!
          IF(PDYN(I,J)<PDYN_MIN(1,MYPE_DOM))THEN
            PDYN_MIN(1,MYPE_DOM)=PDYN(I,J)                                 !<-- Minimum PDYN on this task subdomain
            PDYN_MIN(2,MYPE_DOM)=REAL(I)                                   !<-- I of the local minimum of PDYN
            PDYN_MIN(3,MYPE_DOM)=REAL(J)                                   !<-- J of the local minimum of PDYN
          ENDIF
        ENDDO
        ENDDO
!
!-----------------------------------------------------------------------
!
      ENDIF window
!
!-----------------------------------------------------------------------
!***  Those nest tasks with any of their subdomains inside the search 
!***  window share their PDYN values and locations with all other
!***  nest tasks.
!-----------------------------------------------------------------------
!
      IF(IN_WINDOW(MYPE_DOM))THEN                                          !<-- Tasks only send if they are in the central window
        DO N=0,NUM_PES_FCST-1                                              !<-- Nest window tasks send their PDYN_MIN to all other tasks
          IF(N/=MYPE_DOM)THEN
            CALL MPI_ISSEND(PDYN_MIN(1,MYPE_DOM)                        &  !<-- This task's minimum PDYN with its I,J
                           ,3                                           &  !<-- Sending this many words
                           ,MPI_REAL                                    &  !<-- Datatype
                           ,N                                           &  !<-- Sending to this local nest task ID
                           ,MYPE_DOM                                    &  !<-- Use this task's ID as the tag
                           ,COMM_FCST_TASKS                             &  !<-- Intracommunicator for fcst tasks
                           ,HANDLE_PDYN(N)                              &  !<-- Communication request handle for task N's Recv
                           ,IERR )
          ENDIF
        ENDDO
      ENDIF
!
      DO N=0,NUM_PES_FCST-1                                                !<-- All nest fcst tasks recv PDYN_MIN from window tasks
        IF(N/=MYPE_DOM.AND.IN_WINDOW(N))THEN
          CALL MPI_RECV(PDYN_MIN(1,N)                                   &  !<-- Nest task N's minimum PDYN
                       ,3                                               &  !<-- Receiving this many words
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,N                                               &  !<-- Data was sent by this nest task
                       ,N                                               &  !<-- Tag is the sender's rank
                       ,COMM_FCST_TASKS                                 &  !<-- Intracommunicator for fcst tasks
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
        ENDIF
      ENDDO
!
      IF(IN_WINDOW(MYPE_DOM))THEN                                          !<-- Tasks only send if they are in the central window
        DO N=0,NUM_PES_FCST-1                                              !<-- Nest window tasks send their PDYN_MIN to all other tasks
          IF(N/=MYPE_DOM)THEN
            CALL MPI_WAIT(HANDLE_PDYN(N)                                &  !<-- Proceed only after all Recvs have completed
                         ,JSTAT                                         & 
                         ,IERR )
          ENDIF
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!***  All nest tasks determine the location of the minimum value
!***  of PDYN within the central window.  This will be the new
!***  location of the storm center if the decision is made to
!***  go ahead with the move.
!-----------------------------------------------------------------------
!
      PDYN_MIN_VALS=>PDYN_MIN(1,0:NUM_PES_FCST-1)                          !<-- Select only the PDYN values from the array
!
      ID_PE_MIN=MINLOC(PDYN_MIN_VALS,1)-1                                  !<-- ID of nest task with minimum value of PDYN
!
      SLP_MIN=PDYN_MIN(1,ID_PE_MIN)                                        !<-- Minimum value of PDYN for all tasks
      I_CENTER_NEW=INT(PDYN_MIN(2,ID_PE_MIN))                              !<-- I index of minimum PDYN on the nest domain
      J_CENTER_NEW=INT(PDYN_MIN(3,ID_PE_MIN))                              !<-- J index of minimum PDYN on the nest domain
!
      I_DIFF=I_CENTER_NEW-I_CENTER_CURRENT                                 !<-- Shift in I to potential new center
      J_DIFF=J_CENTER_NEW-J_CENTER_CURRENT                                 !<-- Shift in J to potential new center 
!
!-----------------------------------------------------------------------
!***  If the nest moves then its SW corner must shift from one parent
!***  H point to another which means the I and J shifts must be in
!***  integer multiples of SPACE_RATIO_MY_PARENT.  Adjust I_DIFF and
!***  J_DIFF given this constraint.
!-----------------------------------------------------------------------
!
      IF(MOD(I_DIFF,SPACE_RATIO_MY_PARENT)/=0)THEN
        PARENT_DIFF=REAL(I_DIFF)/REAL(SPACE_RATIO_MY_PARENT)
        IF(ABS(FRACTION(PARENT_DIFF))>0.5)THEN
          I_DIFF=NINT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
        ELSE
          I_DIFF=INT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
        ENDIF
        I_CENTER_NEW=I_CENTER_CURRENT+I_DIFF
      ENDIF
!
      IF(MOD(J_DIFF,SPACE_RATIO_MY_PARENT)/=0)THEN
        PARENT_DIFF=REAL(J_DIFF)/REAL(SPACE_RATIO_MY_PARENT)
        IF(ABS(FRACTION(PARENT_DIFF))>0.5)THEN
          J_DIFF=NINT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
        ELSE
          J_DIFF=INT(PARENT_DIFF)*SPACE_RATIO_MY_PARENT
        ENDIF
        J_CENTER_NEW=J_CENTER_CURRENT+J_DIFF
      ENDIF
!
      IF(ABS(I_DIFF)==0.AND.ABS(J_DIFF)==0)THEN
        IF(MYPE_DOM==0)THEN
!         WRITE(0,*)' NO MOTION: Less than one parent grid increment.'
        ENDIF
        RETURN                                                             !<-- No motion so exit.
      ENDIF
!
!-----------------------------------------------------------------------
!***  Tasks learn if they contain any of the four cardinal direction
!***  points to be used for the storm-gradient check.
!-----------------------------------------------------------------------
!
      N_SEND=4
      DO N=1,4
        NO_VALUE(N)=.FALSE.                                                !<-- Start with all cardinal directions having values inside
      ENDDO
!
      I_PG(1)=I_CENTER_NEW                                                 !<-- I coordinate of north pressure point
      J_PG(1)=J_CENTER_NEW+NPTS_NS                                         !<-- J coordinate of north pressure point
      IF(I_PG(1)<IDS.OR.I_PG(1)>IDE.OR.J_PG(1)<JDS.OR.J_PG(1)>JDE)THEN
        NO_VALUE(1)=.TRUE.                                                 !<-- North point is outside nest domain
        N_SEND=N_SEND-1
      ELSE
        CALL LOCATE_POINT_ON_TASKS(I_PG(1)                              &
                                  ,J_PG(1)                              &
                                  ,I_HOLD_PG_POINT(1))                     !<-- Does this task subdomain contain north PG point?
      ENDIF
!
      I_PG(2)=I_CENTER_NEW                                                 !<-- I coordinate of south pressure point
      J_PG(2)=J_CENTER_NEW-NPTS_NS                                         !<-- J coordinate of south pressure point
      IF(I_PG(2)<IDS.OR.I_PG(2)>IDE.OR.J_PG(2)<JDS.OR.J_PG(2)>JDE)THEN
        NO_VALUE(2)=.TRUE.                                                 !<-- South point is outside nest domain
        N_SEND=N_SEND-1
      ELSE
        CALL LOCATE_POINT_ON_TASKS(I_PG(2)                              &
                                  ,J_PG(2)                              &
                                  ,I_HOLD_PG_POINT(2))                     !<-- Does this task subdomain contain south PG point?
      ENDIF
!
      I_PG(3)=I_CENTER_NEW-NPTS_WE                                         !<-- I coordinate of west pressure point
      J_PG(3)=J_CENTER_NEW                                                 !<-- J coordinate of west pressure point
      IF(I_PG(3)<IDS.OR.I_PG(3)>IDE.OR.J_PG(3)<JDS.OR.J_PG(3)>JDE)THEN
        NO_VALUE(3)=.TRUE.                                                 !<-- West point is outside nest domain
        N_SEND=N_SEND-1
      ELSE
        CALL LOCATE_POINT_ON_TASKS(I_PG(3)                              &
                                  ,J_PG(3)                              &
                                  ,I_HOLD_PG_POINT(3))                     !<-- Does this task subdomain contain west PG point?
      ENDIF
!
      I_PG(4)=I_CENTER_NEW+NPTS_WE                                         !<-- I coordinate of east pressure point
      J_PG(4)=J_CENTER_NEW                                                 !<-- J coordinate of east pressure point
      IF(I_PG(4)<IDS.OR.I_PG(4)>IDE.OR.J_PG(4)<JDS.OR.J_PG(4)>JDE)THEN
        NO_VALUE(4)=.TRUE.                                                 !<-- East point is outside nest domain
        N_SEND=N_SEND-1
      ELSE
        CALL LOCATE_POINT_ON_TASKS(I_PG(4)                              &
                                  ,J_PG(4)                              &
                                  ,I_HOLD_PG_POINT(4))                     !<-- Does this task subdomain contain east PG point?
      ENDIF
!
!-----------------------------------------------------------------------
!***  Those tasks that hold the four points N, S, W, and E of the
!***  new storm center send their pressure values to the task
!***  whose subdomain contains the new storm center.
!-----------------------------------------------------------------------
!
      IF(N_SEND>0)THEN
        DO N=1,4                                                           !<-- The 4 cardinal direction points
          IF(NO_VALUE(N))CYCLE
          IF(I_HOLD_PG_POINT(N))THEN
            PVAL=SLP(I_PG(N),J_PG(N))
            CALL MPI_ISSEND(PVAL                                        &  !<-- SLP at cardinal point N around storm center
                           ,1                                           &  !<-- It is one word
                           ,MPI_REAL                                    &  !<-- Datatype
                           ,ID_PE_MIN                                   &  !<-- ID of task holding the new storm center
                           ,ITAG_PG                                     &  !<-- Tag used for exchange of pressure data for gradient
                           ,COMM_FCST_TASKS                             &  !<-- Intracommunicator for fcst tasks
                           ,HANDLE_PVAL(N)                              &  !<-- Communication request handle for task N's Recv
                           ,IERR )
          ENDIF
        ENDDO
      ELSE
        WRITE(0,*)' ALERT: Storm has moved more than DIST_GRAD beyond'  &
                 ,' moving nest boundary!'
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  The task holding the new storm center saves the maximum
!***  pressure among the four cardinal points then informs all 
!***  other tasks of that value.
!-----------------------------------------------------------------------
!
      IF(MYPE_DOM==ID_PE_MIN)THEN
        PMAX=-100000.
        DO N=1,4
          IF(NO_VALUE(N))CYCLE
          CALL MPI_RECV(PVAL_N                                          &  !<-- Pressure from cardinal point N
                       ,1                                               &  !<-- It is one word
                       ,MPI_REAL                                        &  !<-- Datatype
                       ,MPI_ANY_SOURCE                                  &  !<-- Does not know ID of the sending task
                       ,ITAG_PG                                         &  !<-- Tag used for exchange of pressure data for gradient
                       ,COMM_FCST_TASKS                                 &  !<-- Intracommunicator for fcst tasks
                       ,JSTAT                                           &  !<-- MPI status
                       ,IERR )
!
          IF(PVAL_N>PMAX)THEN
            PMAX=PVAL_N                                                    !<-- Save the maximum pressure.
          ENDIF
!
        ENDDO
      ENDIF
!
      DO N=1,4                                                             !<-- The 4 cardinal directions
        IF(NO_VALUE(N))CYCLE
        IF(I_HOLD_PG_POINT(N))THEN
          CALL MPI_WAIT(HANDLE_PVAL(N)                                  &  !<-- Proceed only after all Recvs have completed
                       ,JSTAT                                           & 
                       ,IERR )
        ENDIF
      ENDDO
!
      IF(N_SEND>0)THEN
        CALL MPI_BCAST(PMAX                                             &  !<-- Max cardinal pressure around storm
                      ,1                                                &  !<-- It is one word
                      ,MPI_REAL                                         &  !<-- Datatype
                      ,ID_PE_MIN                                        &  !<-- The root sender
                      ,COMM_FCST_TASKS                                  &  !<-- Intracommunicator for fcst tasks
                      ,IERR )
        IF(PMAX<50000.)PMAX=1000000.
      ELSE
        PMAX=1000000.
      ENDIF
!
!-----------------------------------------------------------------------
!***  Now that a new central pressure and its location have been 
!***  identified several conditions must be met before the move
!***  can be allowed to execute.  We have already made certain
!***  that the nest domain's SW corner remains on a parent H point
!***  if the shift is executed.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  (1) Did the vortex disappear?
!-----------------------------------------------------------------------
!
      IF(PMAX<SLP_MIN)THEN
        IF(MYPE_DOM==0)THEN
          WRITE(0,*)' CANNOT MOVE:  Lost the vortex.'
        ENDIF
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  (2) Is the storm-scale pressure gradient too weak? 
!-----------------------------------------------------------------------
!
      IF(PMAX-SLP_MIN<PGRD_MIN)THEN
        IF(MYPE_DOM==0)THEN
          WRITE(0,*)' DO NOT MOVE:  Pressure gradient too weak.'
        ENDIF
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  (3) Has the vortex been lost over land?
!-----------------------------------------------------------------------
!
      DIST_I=I_DIFF*DX(J_CENTER_NEW)                                       !<-- Shift distance (m) in I
      DIST_J=J_DIFF*DY                                                     !<-- Shift distance (m) in J
!
      IF(FRAC_SEA<=0.2.AND.DIST_I>DIST_LAND.AND.DIST_J>DIST_LAND)THEN
        IF(MYPE_DOM==0)THEN
          WRITE(0,*)' CANNOT MOVE:  Vortex lost over land.'
        ENDIF
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  (4) Is the vortex too weak over land?
!-----------------------------------------------------------------------
!
      IF(FRAC_SEA<=0.2.AND.PMAX-SLP_MIN<PGRD_MIN_LAND)THEN
        IF(MYPE_DOM==0)THEN
          WRITE(0,*)' DO NOT MOVE:  Vortex is too weak over land.'
        ENDIF
        RETURN
      ENDIF
!
!-----------------------------------------------------------------------
!***  The nest mechanics are anchored on the parent's I,J of the
!***  nest's SW corner (H point).  Given the new center point
!***  what is the parent I,J of the nest's SW corner after it moves?
!-----------------------------------------------------------------------
!
      I_WANT_TO_MOVE=.TRUE.
!
      I_SW_PARENT_NEW=I_SW_PARENT_CURRENT+I_DIFF/SPACE_RATIO_MY_PARENT
      J_SW_PARENT_NEW=J_SW_PARENT_CURRENT+J_DIFF/SPACE_RATIO_MY_PARENT
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!
      SUBROUTINE LOCATE_POINT_ON_TASKS(I_PG                             &
                                      ,J_PG                             &
                                      ,I_HOLD_THIS_POINT )
!
!-----------------------------------------------------------------------
!***  Find the ID of the task whose subdomain contains 
!***  point (I_PG,J_PG).
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: I_PG                             &  !<-- I index of point in question
                                      ,J_PG                                !<-- J index of point in question
!
      LOGICAL(kind=KLOG),INTENT(OUT) :: I_HOLD_THIS_POINT                  !<-- This task subdomain holds the point?
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      I_HOLD_THIS_POINT=.FALSE.
!
      IF(I_PG>=ITS.AND.I_PG<=ITE.AND.J_PG>=JTS.AND.J_PG<=JTE)THEN
        I_HOLD_THIS_POINT=.TRUE.
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE LOCATE_POINT_ON_TASKS
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE COMPUTE_STORM_MOTION
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
      SUBROUTINE SPLINE(NOLD,XOLD,YOLD,Y2,Y2_K,NNEW,XNEW,YNEW)
!-----------------------------------------------------------------------
!
!     ******************************************************************
!     *                                                                *
!     *  This is a one-dimensional cubic spline fitting routine        *
!     *  programmed for a small scalar machine.                        *
!     *                                                                *
!     *  Programmer: Z. Janjic, Yugoslav Fed. Hydromet. Inst., Beograd *
!     *                                                                *
!     *  NOLD - Number of given values of the function.  Must be >= 3. *
!     *  XOLD - Locations of the points at which the values of the     *
!     *         function are given.  Must be in ascending order.       *
!     *  YOLD - The given values of the function at the points XOLD.   *
!     *  Y2   - The second derivatives at the points XOLD.  If natural *
!     *         spline is fitted Y2(1)=0 and Y2(nold)=0. Must be       *
!     *         specified.                                             *
!     *  Y2_K - Vertical dimension of Y2 array.                        *
!     *  NNEW - Number of values of the function to be calculated.     *
!     *  XNEW - Locations of the points at which the values of the     *
!     *         function are calculated.  XNEW(K) must be >= XOLD(1)   *
!     *         and <= XOLD(NOLD).                                     *
!     *  YNEW - The values of the function to be calculated.           *
!     *                                                                *
!     ******************************************************************
!
!------------------------
!***  Argument variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: NNEW,NOLD,Y2_K
!
      REAL(kind=KFPT),DIMENSION(1:NOLD),INTENT(IN) :: XOLD,YOLD
      REAL(kind=KFPT),DIMENSION(1:NNEW),INTENT(IN) :: XNEW
!
      REAL(kind=KFPT),DIMENSION(1:Y2_K),INTENT(INOUT) :: Y2
!
      REAL(kind=KFPT),DIMENSION(1:NNEW),INTENT(OUT) :: YNEW
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: K,K1,K2,KOLD,NOLDM1
!
      REAL(kind=KFPT) :: AK,BK,CK,DEN,DX,DXC,DXL,DXR,DYDXL,DYDXR        &
                        ,RDX,RTDXC,X,XK,XSQ,Y2K,Y2KP1
!
      REAL(kind=KFPT),DIMENSION(1:NOLD-2) :: P,Q
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      NOLDM1=NOLD-1
!
      DXL=XOLD(2)-XOLD(1)
      DXR=XOLD(3)-XOLD(2)
      DYDXL=(YOLD(2)-YOLD(1))/DXL
      DYDXR=(YOLD(3)-YOLD(2))/DXR
      RTDXC=0.5/(DXL+DXR)
!
      P(1)= RTDXC*(6.*(DYDXR-DYDXL)-DXL*Y2(1))
      Q(1)=-RTDXC*DXR
!
      IF(NOLD==3) GO TO 700
!
!-----------------------------------------------------------------------
!
      K=3
!
  100 CONTINUE
      DXL=DXR
      DYDXL=DYDXR
      DXR=XOLD(K+1)-XOLD(K)
      DYDXR=(YOLD(K+1)-YOLD(K))/DXR
      DXC=DXL+DXR
      DEN=1./(DXL*Q(K-2)+DXC+DXC)
!
      P(K-1)= DEN*(6.*(DYDXR-DYDXL)-DXL*P(K-2))
      Q(K-1)=-DEN*DXR
!
      K=K+1
      IF(K<NOLD) GO TO 100
!
!-----------------------------------------------------------------------
!
  700 CONTINUE
      K=NOLDM1
!
  200 CONTINUE
      Y2(K)=P(K-1)+Q(K-1)*Y2(K+1)
!
      K=K-1
      IF(K>1) GO TO 200
!
!-----------------------------------------------------------------------
!
      K1=1
!
  300 CONTINUE
      XK=XNEW(K1)
!
      DO 400 K2=2,NOLD
        IF(XOLD(K2)<=XK) GO TO 400
        KOLD=K2-1
        GO TO 450
  400 CONTINUE
!
      YNEW(K1)=YOLD(NOLD)
      GO TO 600
!
  450 CONTINUE
      IF(K1==1)   GO TO 500
      IF(K==KOLD) GO TO 550
!
  500 CONTINUE
      K=KOLD
!
      Y2K=Y2(K)
      Y2KP1=Y2(K+1)
      DX=XOLD(K+1)-XOLD(K)
      RDX=1./DX
!
      AK=0.1666667*RDX*(Y2KP1-Y2K)
      BK=0.5*Y2K
      CK=RDX*(YOLD(K+1)-YOLD(K))-0.1666667*DX*(Y2KP1+Y2K+Y2K)
!
  550 CONTINUE
      X=XK-XOLD(K)
      XSQ=X*X
!
      YNEW(K1)=AK*XSQ*X+BK*XSQ+CK*X+YOLD(K)
!
  600 CONTINUE
      K1=K1+1
!
      IF(K1<=NNEW) GO TO 300
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE SPLINE
!
!--------------------------------------------------------------------
      subroutine interp_linear ( x_data, vbl_data, x_interp, vbl_interp )
          implicit none

          real, intent(in) :: x_data(:), vbl_data(:), x_interp(:)
          real, intent(out) :: vbl_interp(:)

          integer interp, n, left, right

          if ( .not. ascends_strictly(x_data) ) then
              write ( *, '(a)' ) ' '
              write ( *, '(a)' ) 'INTERP_LINEAR - Fatal error!'
              write ( *, '(a)' ) '  Independent variable array T_DATA not strictly increasing.'
              stop 1
          end if

          n = size(x_interp,1)

          do interp = 1, n

              if( (x_interp(interp)).gt.(x_data(n)) ) then
                  vbl_interp(interp) = vbl_data(interp)
              else
                  call vec_bracket ( x_data, x_interp(interp), left, right )
                  vbl_interp(interp) = ( ( x_data(right) - x_interp(interp) ) * vbl_data(left)    &
                                       + ( x_interp(interp) - x_data(left) ) * vbl_data(right) )  &
                                       / ( x_data(right) - x_data(left) )
              end if

          end do

          contains
              pure function ascends_strictly(x)

                  real, intent(in) :: x(:)
                  logical :: ascends_strictly
                  integer :: i

                  ascends_strictly = .true.

                  do i = 1,size(x)-1
                      if ( x(i+1) .le. x(i) ) then
                          ascends_strictly = .false.
                          exit
                      end if
                  end do

              end function

              subroutine vec_bracket ( x, xval, left, right )

                  real, intent(in) :: x(:),xval
                  integer, intent(out) :: left, right

                  integer :: i

                  do i = 2, size(x)
                      if ( (xval).le.(x(i)) ) then
                          left = i-1
                          right = i
                          exit
                      end if
                  end do

              end subroutine vec_bracket
      end subroutine interp_linear
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine artificial_move(ntimestep                              &
                                ,kount_moves                            &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,kount_moves                      &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
!
      write(0,*)' enter artificial ntimestep=',ntimestep,' kount_moves=',kount_moves
      if(ntimestep>0.and.mod(ntimestep,51)==0)then
        i_want_to_move=.true.   
      write(0,*)' artificial set i_want_to_move=',i_want_to_move
        if(mod(kount_moves,16)<= 1)then                                    !<-- NW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NW'
        elseif(mod(kount_moves,16)<= 3)then                                !<-- N
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to N'
        elseif(mod(kount_moves,16)<= 5)then                                !<-- NE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NE'
        elseif(mod(kount_moves,16)<= 7)then                                !<-- E
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to E'
        elseif(mod(kount_moves,16)<= 9)then                                !<-- SE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SE'
        elseif(mod(kount_moves,16)<=11)then                                !<-- S
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to S'
        elseif(mod(kount_moves,16)<=13)then                                !<-- SW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW'
        elseif(mod(kount_moves,16)<=15)then                                !<-- W
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to W'
        endif
      endif
      write(0,*)' exit artificial_move ntimestep=',ntimestep,' mod=',mod(ntimestep,14) &
               ,' i_want_to_move=',i_want_to_move
!
!-----------------------------------------------------------------------
      end subroutine artificial_move
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine artificial_move2(ntimestep                              &
                                ,kount_moves                            &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,kount_moves                      &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
      integer(kind=kint) :: mod_km
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
!
      write(0,*)' enter artificial ntimestep=',ntimestep,' kount_moves=',kount_moves
!!!   if(ntimestep>3.and.mod(ntimestep,14)<=2)then
      if(ntimestep>0.and.mod(ntimestep+3,51)==0)then
        i_want_to_move=.true.   
      write(0,*)' artificial set i_want_to_move=',i_want_to_move
        mod_km=mod(kount_moves,16)
        if(mod_km<=01)then                                                 !<-- E
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to E mod_km=',mod_km
        elseif(mod_km<=03)then                                             !<-- NE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NE mod_km=',mod_km
        elseif(mod_km<=05)then                                             !<-- N
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to N mod_km=',mod_km
        elseif(mod_km<=07)then                                             !<-- NW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NW mod_km=',mod_km
        elseif(mod_km<=09)then                                             !<-- W
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to W mod_km=',mod_km
        elseif(mod_km<=11)then                                             !<-- SW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW mod_km=',mod_km
        elseif(mod_km<=13)then                                             !<-- S
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to S mod_km=',mod_km
        elseif(mod_km<=15)then                                             !<-- SE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SE mod_km=',mod_km
        endif
      endif
      write(0,*)' exit artificial_move ntimestep=',ntimestep,' mod=',mod(ntimestep+3,51) &
               ,' i_want_to_move=',i_want_to_move
!
!-----------------------------------------------------------------------
      end subroutine artificial_move2
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine artificial_move3(ntimestep                              &
                                ,kount_moves                            &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,kount_moves                      &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
      integer(kind=kint) :: mod_km
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
!
      write(0,*)' enter artificial ntimestep=',ntimestep,' kount_moves=',kount_moves
!!!   if(ntimestep>3.and.mod(ntimestep,14)<=2)then
      if(ntimestep>0.and.mod(ntimestep+3,51)==0)then
        i_want_to_move=.true.   
      write(0,*)' artificial set i_want_to_move=',i_want_to_move
        mod_km=mod(kount_moves,16)
        if(mod_km<=01)then                                                 !<-- NW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NW mod_km=',mod_km
        elseif(mod_km<=03)then                                             !<-- N
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to N mod_km=',mod_km
        elseif(mod_km<=05)then                                             !<-- NE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NE mod_km=',mod_km
        elseif(mod_km<=07)then                                             !<-- E
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to E mod_km=',mod_km
        elseif(mod_km<=09)then                                             !<-- SE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SE mod_km=',mod_km
        elseif(mod_km<=11)then                                             !<-- S
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to S mod_km=',mod_km
        elseif(mod_km<=13)then                                             !<-- SW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW mod_km=',mod_km
        elseif(mod_km<=15)then                                             !<-- W
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to W mod_km=',mod_km
        endif
      endif
      write(0,*)' exit artificial_move ntimestep=',ntimestep,' mod=',mod(ntimestep+3,51) &
               ,' i_want_to_move=',i_want_to_move
!
!-----------------------------------------------------------------------
      end subroutine artificial_move3
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine artificial_move4(ntimestep                              &
                                ,kount_moves                            &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,kount_moves                      &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
!
      write(0,*)' enter artificial ntimestep=',ntimestep,' kount_moves=',kount_moves
      if(ntimestep>3.and.mod(ntimestep,14)<=2)then
        i_want_to_move=.true.   
      write(0,*)' artificial set i_want_to_move=',i_want_to_move
        if(mod(kount_moves,45)<=5)then                                     !<-- E
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to NW'
        elseif(mod(kount_moves,45)<=11)then                                !<-- NE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to N'
        elseif(mod(kount_moves,45)<=16)then                                !<-- N
          i_sw_parent_new=i_sw_parent_current  
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NE'
        elseif(mod(kount_moves,45)<=22)then                                !<-- NW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to E'
        elseif(mod(kount_moves,45)<=27)then                                !<-- W
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current  
      write(0,*)' artificial to SE'
        elseif(mod(kount_moves,45)<=33)then                                !<-- SW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to S'
        elseif(mod(kount_moves,45)<=38)then                                !<-- S
          i_sw_parent_new=i_sw_parent_current  
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW'
        elseif(mod(kount_moves,45)<=44)then                                !<-- SW
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to W'
        endif
      endif
      write(0,*)' exit artificial_move ntimestep=',ntimestep,' mod=',mod(ntimestep,14) &
               ,' i_want_to_move=',i_want_to_move
!
!-----------------------------------------------------------------------
      end subroutine artificial_move4
!-----------------------------------------------------------------------
!      
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine artificial_move5(ntimestep                              &
                                ,kount_moves                            &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,kount_moves                      &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
!
      write(0,*)' enter artificial ntimestep=',ntimestep,' kount_moves=',kount_moves
      if(ntimestep>3.and.mod(ntimestep,15)==0)then
        i_want_to_move=.true.
      write(0,*)' artificial set i_want_to_move=',i_want_to_move
        if(mod(kount_moves,40)<5)then                                     !<-- E
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to E',kount_moves
        elseif(mod(kount_moves,40)<10)then                                !<-- NE
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NE',kount_moves
        elseif(mod(kount_moves,40)<15)then                                !<-- N
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to N',kount_moves
        elseif(mod(kount_moves,40)<20)then                                !<-- NW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current+1
      write(0,*)' artificial to NW',kount_moves
        elseif(mod(kount_moves,40)<25)then                                !<-- W
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current
      write(0,*)' artificial to W',kount_moves
        elseif(mod(kount_moves,40)<30)then                                !<-- SW
          i_sw_parent_new=i_sw_parent_current-1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW',kount_moves
        elseif(mod(kount_moves,40)<35)then                                !<-- S
          i_sw_parent_new=i_sw_parent_current
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to S',kount_moves
        elseif(mod(kount_moves,40)<40)then                                !<-- SW
          i_sw_parent_new=i_sw_parent_current+1
          j_sw_parent_new=j_sw_parent_current-1
      write(0,*)' artificial to SW',kount_moves
        endif
      endif
      write(0,*)' exit artificial_move ntimestep=',ntimestep,' mod=',mod(ntimestep,14) &
               ,' i_want_to_move=',i_want_to_move
!
!-----------------------------------------------------------------------
      end subroutine artificial_move5
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine prescribed_move(ntimestep,dt                           &
                                ,i_want_to_move                         &
                                ,i_sw_parent_current                    &
                                ,j_sw_parent_current                    &
                                ,i_sw_parent_new                        &
                                ,j_sw_parent_new )
!
!-----------------------------------------------------------------------
!
      real(KIND=kfpt),intent(in) :: dt
!
      integer(kind=kint),intent(in) :: i_sw_parent_current              &
                                      ,j_sw_parent_current              &
                                      ,ntimestep
!
      integer(kind=kint),intent(out) :: i_sw_parent_new                 &
                                       ,j_sw_parent_new
!
      logical(kind=klog),intent(out) :: i_want_to_move
!
      integer, save :: kount_moves = 1
      integer :: nsteps_move
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      i_want_to_move=.false.
      i_sw_parent_new = 0
      j_sw_parent_new = 0

      nsteps_move = MOVE_INTERVAL_MINUTES*60/DT
      if ( ntimestep>0 .and. mod(ntimestep,nsteps_move)<3 ) then
         kount_moves=kount_moves+1
         if (kount_moves > size(MOVE_I_SW) ) return
         write(0,"(A,4I6)")' WILL_MOVE_NOW ',ntimestep,kount_moves,     &
                           MOVE_I_SW(kount_moves),MOVE_J_SW(kount_moves)
         i_want_to_move=.true.
         i_sw_parent_new = MOVE_I_SW(kount_moves)
         j_sw_parent_new = MOVE_J_SW(kount_moves)
      end if
!
!-----------------------------------------------------------------------
      end subroutine prescribed_move
!-----------------------------------------------------------------------
!
      END MODULE MODULE_PARENT_CHILD_CPL_COMP
!
!-----------------------------------------------------------------------
