MODULE module_comm_dm_2 IMPLICIT NONE PRIVATE module_comm_dm_dummy_2 INTEGER, PRIVATE :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER, PRIVATE :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER, PRIVATE :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CONTAINS SUBROUTINE module_comm_dm_dummy_2 USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants RETURN END SUBROUTINE module_comm_dm_dummy_2 SUBROUTINE HALO_NMM_INIT_41_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_INIT_41_inline.inc') CALL rsl_comm_iter_init(5,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%dqrcudt,1)*SIZE(grid%dqrcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqrcudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqicudt,1)*SIZE(grid%dqicudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqicudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqscudt,1)*SIZE(grid%dqscudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqscudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%dqrcudt,1)*SIZE(grid%dqrcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqrcudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqicudt,1)*SIZE(grid%dqicudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqicudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqscudt,1)*SIZE(grid%dqscudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqscudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(5,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%dqrcudt,1)*SIZE(grid%dqrcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqrcudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqicudt,1)*SIZE(grid%dqicudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqicudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqscudt,1)*SIZE(grid%dqscudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqscudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%dqrcudt,1)*SIZE(grid%dqrcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqrcudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqicudt,1)*SIZE(grid%dqicudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqicudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dqscudt,1)*SIZE(grid%dqscudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqscudt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_41_sub SUBROUTINE HALO_NMM_A_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_A_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 8, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 8, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_A_sub SUBROUTINE HALO_NMM_A_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_A_3_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_A_3_sub SUBROUTINE HALO_NMM_B_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_B_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%div,1)*SIZE(grid%div,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%div, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_B_sub SUBROUTINE HALO_NMM_C_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_C_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_C_sub SUBROUTINE HALO_NMM_D_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_D_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_D_sub SUBROUTINE HALO_NMM_E_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_E_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_E_sub SUBROUTINE HALO_NMM_F_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_F_inline.inc') CALL rsl_comm_iter_init(5,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(5,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_F_sub SUBROUTINE HALO_NMM_F1_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_F1_inline.inc') CALL rsl_comm_iter_init(5,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 8, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pdslo,1)*SIZE(grid%pdslo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pdslo, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fne,1)*SIZE(grid%fne,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fne, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fse,1)*SIZE(grid%fse,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fse, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%uold,1)*SIZE(grid%uold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%vold,1)*SIZE(grid%vold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%told,1)*SIZE(grid%told,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%told, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fns,1)*SIZE(grid%fns,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fns, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pdslo,1)*SIZE(grid%pdslo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pdslo, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fne,1)*SIZE(grid%fne,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fne, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fse,1)*SIZE(grid%fse,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fse, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%uold,1)*SIZE(grid%uold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%vold,1)*SIZE(grid%vold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%told,1)*SIZE(grid%told,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%told, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fns,1)*SIZE(grid%fns,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fns, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(5,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 5 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 5, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 8, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pdslo,1)*SIZE(grid%pdslo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pdslo, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fne,1)*SIZE(grid%fne,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fne, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fse,1)*SIZE(grid%fse,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fse, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%uold,1)*SIZE(grid%uold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%vold,1)*SIZE(grid%vold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%told,1)*SIZE(grid%told,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%told, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fns,1)*SIZE(grid%fns,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fns, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pdslo,1)*SIZE(grid%pdslo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pdslo, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fne,1)*SIZE(grid%fne,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fne, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fse,1)*SIZE(grid%fse,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fse, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%uold,1)*SIZE(grid%uold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%vold,1)*SIZE(grid%vold,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vold, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%told,1)*SIZE(grid%told,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%told, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%petdt,1)*SIZE(grid%petdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%petdt, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%fns,1)*SIZE(grid%fns,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fns, 5,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_F1_sub SUBROUTINE HALO_NMM_G_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_G_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%fad,1)*SIZE(grid%fad,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fad, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%fad,1)*SIZE(grid%fad,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fad, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%fad,1)*SIZE(grid%fad,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fad, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%fad,1)*SIZE(grid%fad,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fad, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_G_sub SUBROUTINE HALO_NMM_H_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_H_inline.inc') CALL rsl_comm_iter_init(4,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 4 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 4, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(4,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 4 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 4, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%few,1)*SIZE(grid%few,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%few, 4,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_H_sub SUBROUTINE HALO_NMM_I_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_I_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%rrw,1)*SIZE(grid%rrw,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rrw, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%rrw,1)*SIZE(grid%rrw,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rrw, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%rrw,1)*SIZE(grid%rrw,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rrw, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%rrw,1)*SIZE(grid%rrw,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rrw, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_I_sub SUBROUTINE HALO_NMM_I_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_I_3_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_I_3_sub SUBROUTINE HALO_NMM_J_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_J_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_J_sub SUBROUTINE HALO_NMM_J_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_J_3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_J_3_sub SUBROUTINE HALO_NMM_K_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_K_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_K_sub SUBROUTINE HALO_NMM_L_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_L_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_L_sub SUBROUTINE HALO_NMM_L_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_L_3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_L_3_sub SUBROUTINE HALO_NMM_MG_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_MG_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_MG_sub SUBROUTINE HALO_NMM_MG2_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_MG2_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_MG2_sub SUBROUTINE HALO_NMM_MG3_sub ( grid, & config_flags, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid TYPE(grid_config_rec_type) , INTENT(IN) :: config_flags INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_NMM_MG3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%num_metgrid_levels & )) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%num_metgrid_levels & )) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_MG3_sub END MODULE module_comm_dm_2