MODULE module_comm_dm_1 IMPLICIT NONE PRIVATE module_comm_dm_dummy_1 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_1 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_1 SUBROUTINE HALO_NMM_INIT_20_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_20_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, & 0, 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& )) IF ( SIZE(grid%cfracl,1)*SIZE(grid%cfracl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracl, 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%thz0,1)*SIZE(grid%thz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%thz0, 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%qz0,1)*SIZE(grid%qz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%qz0, 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 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%cfracl,1)*SIZE(grid%cfracl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracl, 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%thz0,1)*SIZE(grid%thz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%thz0, 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%qz0,1)*SIZE(grid%qz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%qz0, 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 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, & 0, 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& )) IF ( SIZE(grid%cfracl,1)*SIZE(grid%cfracl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracl, 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%thz0,1)*SIZE(grid%thz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%thz0, 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%qz0,1)*SIZE(grid%qz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%qz0, 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 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%cfracl,1)*SIZE(grid%cfracl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracl, 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%thz0,1)*SIZE(grid%thz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%thz0, 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%qz0,1)*SIZE(grid%qz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%qz0, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_20_sub SUBROUTINE HALO_NMM_INIT_21_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_21_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, & 0, 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& )) IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 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%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 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%ustar,1)*SIZE(grid%ustar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ustar, 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 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%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 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%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 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%ustar,1)*SIZE(grid%ustar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ustar, 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 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, & 0, 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& )) IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 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%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 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%ustar,1)*SIZE(grid%ustar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ustar, 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 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%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 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%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 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%ustar,1)*SIZE(grid%ustar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ustar, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_21_sub SUBROUTINE HALO_NMM_INIT_22_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_22_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, & 0, 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& )) IF ( SIZE(grid%htop,1)*SIZE(grid%htop,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%htop, 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%cfracm,1)*SIZE(grid%cfracm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracm, 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%sno,1)*SIZE(grid%sno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sno, 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 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%htop,1)*SIZE(grid%htop,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%htop, 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%cfracm,1)*SIZE(grid%cfracm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracm, 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%sno,1)*SIZE(grid%sno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sno, 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 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, & 0, 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& )) IF ( SIZE(grid%htop,1)*SIZE(grid%htop,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%htop, 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%cfracm,1)*SIZE(grid%cfracm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracm, 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%sno,1)*SIZE(grid%sno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sno, 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 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%htop,1)*SIZE(grid%htop,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%htop, 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%cfracm,1)*SIZE(grid%cfracm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfracm, 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%sno,1)*SIZE(grid%sno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sno, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_22_sub SUBROUTINE HALO_NMM_INIT_23_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_23_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, & 0, 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& )) IF ( SIZE(grid%si,1)*SIZE(grid%si,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%si, 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%cldefi,1)*SIZE(grid%cldefi,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cldefi, 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%rf,1)*SIZE(grid%rf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rf, 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 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%si,1)*SIZE(grid%si,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%si, 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%cldefi,1)*SIZE(grid%cldefi,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cldefi, 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%rf,1)*SIZE(grid%rf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rf, 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 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, & 0, 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& )) IF ( SIZE(grid%si,1)*SIZE(grid%si,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%si, 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%cldefi,1)*SIZE(grid%cldefi,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cldefi, 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%rf,1)*SIZE(grid%rf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rf, 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 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%si,1)*SIZE(grid%si,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%si, 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%cldefi,1)*SIZE(grid%cldefi,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cldefi, 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%rf,1)*SIZE(grid%rf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rf, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_23_sub SUBROUTINE HALO_NMM_INIT_24_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_24_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, & 0, 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& )) IF ( SIZE(grid%cuppt,1)*SIZE(grid%cuppt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuppt, 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%cfrach,1)*SIZE(grid%cfrach,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfrach, 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%soiltb,1)*SIZE(grid%soiltb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%soiltb, 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 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%cuppt,1)*SIZE(grid%cuppt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuppt, 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%cfrach,1)*SIZE(grid%cfrach,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfrach, 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%soiltb,1)*SIZE(grid%soiltb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%soiltb, 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 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, & 0, 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& )) IF ( SIZE(grid%cuppt,1)*SIZE(grid%cuppt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuppt, 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%cfrach,1)*SIZE(grid%cfrach,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfrach, 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%soiltb,1)*SIZE(grid%soiltb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%soiltb, 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 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%cuppt,1)*SIZE(grid%cuppt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuppt, 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%cfrach,1)*SIZE(grid%cfrach,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cfrach, 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%soiltb,1)*SIZE(grid%soiltb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%soiltb, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_24_sub SUBROUTINE HALO_NMM_INIT_25_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_25_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, & 0, 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& )) IF ( SIZE(grid%sfcexc,1)*SIZE(grid%sfcexc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcexc, 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%smstav,1)*SIZE(grid%smstav,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstav, 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%smstot,1)*SIZE(grid%smstot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstot, 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 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%sfcexc,1)*SIZE(grid%sfcexc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcexc, 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%smstav,1)*SIZE(grid%smstav,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstav, 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%smstot,1)*SIZE(grid%smstot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstot, 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 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, & 0, 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& )) IF ( SIZE(grid%sfcexc,1)*SIZE(grid%sfcexc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcexc, 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%smstav,1)*SIZE(grid%smstav,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstav, 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%smstot,1)*SIZE(grid%smstot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstot, 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 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%sfcexc,1)*SIZE(grid%sfcexc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcexc, 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%smstav,1)*SIZE(grid%smstav,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstav, 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%smstot,1)*SIZE(grid%smstot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smstot, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_25_sub SUBROUTINE HALO_NMM_INIT_26_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_26_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, & 0, 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& )) IF ( SIZE(grid%grnflx,1)*SIZE(grid%grnflx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%grnflx, 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%pctsno,1)*SIZE(grid%pctsno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pctsno, 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%rlwin,1)*SIZE(grid%rlwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rlwin, 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 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%grnflx,1)*SIZE(grid%grnflx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%grnflx, 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%pctsno,1)*SIZE(grid%pctsno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pctsno, 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%rlwin,1)*SIZE(grid%rlwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rlwin, 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 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, & 0, 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& )) IF ( SIZE(grid%grnflx,1)*SIZE(grid%grnflx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%grnflx, 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%pctsno,1)*SIZE(grid%pctsno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pctsno, 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%rlwin,1)*SIZE(grid%rlwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rlwin, 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 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%grnflx,1)*SIZE(grid%grnflx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%grnflx, 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%pctsno,1)*SIZE(grid%pctsno,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pctsno, 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%rlwin,1)*SIZE(grid%rlwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%rlwin, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_26_sub SUBROUTINE HALO_NMM_INIT_27_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_27_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, & 0, 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& )) IF ( SIZE(grid%radot,1)*SIZE(grid%radot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%radot, 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%czmean,1)*SIZE(grid%czmean,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%czmean, 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%sigt4,1)*SIZE(grid%sigt4,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sigt4, 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 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%radot,1)*SIZE(grid%radot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%radot, 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%czmean,1)*SIZE(grid%czmean,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%czmean, 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%sigt4,1)*SIZE(grid%sigt4,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sigt4, 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 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, & 0, 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& )) IF ( SIZE(grid%radot,1)*SIZE(grid%radot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%radot, 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%czmean,1)*SIZE(grid%czmean,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%czmean, 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%sigt4,1)*SIZE(grid%sigt4,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sigt4, 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 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%radot,1)*SIZE(grid%radot,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%radot, 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%czmean,1)*SIZE(grid%czmean,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%czmean, 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%sigt4,1)*SIZE(grid%sigt4,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sigt4, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_27_sub SUBROUTINE HALO_NMM_INIT_28_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_28_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, & 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%sr,1)*SIZE(grid%sr,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sr, 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 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%sr,1)*SIZE(grid%sr,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sr, 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 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, & 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%sr,1)*SIZE(grid%sr,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sr, 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 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%sr,1)*SIZE(grid%sr,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sr, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_28_sub SUBROUTINE HALO_NMM_INIT_29_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_29_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, & 0, 4, 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%prec,1)*SIZE(grid%prec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%prec, 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%acprec,1)*SIZE(grid%acprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acprec, 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%accliq,1)*SIZE(grid%accliq,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%accliq, 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%cuprec,1)*SIZE(grid%cuprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuprec, 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 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%prec,1)*SIZE(grid%prec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%prec, 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%acprec,1)*SIZE(grid%acprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acprec, 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%accliq,1)*SIZE(grid%accliq,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%accliq, 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%cuprec,1)*SIZE(grid%cuprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuprec, 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 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, & 0, 4, 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%prec,1)*SIZE(grid%prec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%prec, 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%acprec,1)*SIZE(grid%acprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acprec, 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%accliq,1)*SIZE(grid%accliq,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%accliq, 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%cuprec,1)*SIZE(grid%cuprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuprec, 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 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%prec,1)*SIZE(grid%prec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%prec, 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%acprec,1)*SIZE(grid%acprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acprec, 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%accliq,1)*SIZE(grid%accliq,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%accliq, 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%cuprec,1)*SIZE(grid%cuprec,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cuprec, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_29_sub SUBROUTINE HALO_NMM_INIT_30_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_30_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, & 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%acfrst,1)*SIZE(grid%acfrst,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acfrst, 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%acsnow,1)*SIZE(grid%acsnow,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnow, 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 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%acfrst,1)*SIZE(grid%acfrst,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acfrst, 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%acsnow,1)*SIZE(grid%acsnow,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnow, 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 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, & 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%acfrst,1)*SIZE(grid%acfrst,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acfrst, 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%acsnow,1)*SIZE(grid%acsnow,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnow, 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 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%acfrst,1)*SIZE(grid%acfrst,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acfrst, 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%acsnow,1)*SIZE(grid%acsnow,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnow, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_30_sub SUBROUTINE HALO_NMM_INIT_31_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_31_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, & 0, 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& )) IF ( SIZE(grid%acsnom,1)*SIZE(grid%acsnom,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnom, 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%ssroff,1)*SIZE(grid%ssroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ssroff, 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%bgroff,1)*SIZE(grid%bgroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bgroff, 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 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%acsnom,1)*SIZE(grid%acsnom,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnom, 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%ssroff,1)*SIZE(grid%ssroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ssroff, 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%bgroff,1)*SIZE(grid%bgroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bgroff, 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 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, & 0, 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& )) IF ( SIZE(grid%acsnom,1)*SIZE(grid%acsnom,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnom, 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%ssroff,1)*SIZE(grid%ssroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ssroff, 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%bgroff,1)*SIZE(grid%bgroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bgroff, 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 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%acsnom,1)*SIZE(grid%acsnom,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%acsnom, 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%ssroff,1)*SIZE(grid%ssroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ssroff, 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%bgroff,1)*SIZE(grid%bgroff,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bgroff, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_31_sub SUBROUTINE HALO_NMM_INIT_32_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_32_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, & 0, 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& )) IF ( SIZE(grid%sfcshx,1)*SIZE(grid%sfcshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcshx, 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%sfclhx,1)*SIZE(grid%sfclhx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfclhx, 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%subshx,1)*SIZE(grid%subshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%subshx, 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 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%sfcshx,1)*SIZE(grid%sfcshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcshx, 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%sfclhx,1)*SIZE(grid%sfclhx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfclhx, 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%subshx,1)*SIZE(grid%subshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%subshx, 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 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, & 0, 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& )) IF ( SIZE(grid%sfcshx,1)*SIZE(grid%sfcshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcshx, 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%sfclhx,1)*SIZE(grid%sfclhx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfclhx, 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%subshx,1)*SIZE(grid%subshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%subshx, 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 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%sfcshx,1)*SIZE(grid%sfcshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcshx, 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%sfclhx,1)*SIZE(grid%sfclhx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfclhx, 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%subshx,1)*SIZE(grid%subshx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%subshx, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_32_sub SUBROUTINE HALO_NMM_INIT_33_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_33_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, & 0, 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& )) IF ( SIZE(grid%snopcx,1)*SIZE(grid%snopcx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%snopcx, 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%sfcuvx,1)*SIZE(grid%sfcuvx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcuvx, 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%sfcevp,1)*SIZE(grid%sfcevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcevp, 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 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%snopcx,1)*SIZE(grid%snopcx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%snopcx, 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%sfcuvx,1)*SIZE(grid%sfcuvx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcuvx, 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%sfcevp,1)*SIZE(grid%sfcevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcevp, 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 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, & 0, 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& )) IF ( SIZE(grid%snopcx,1)*SIZE(grid%snopcx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%snopcx, 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%sfcuvx,1)*SIZE(grid%sfcuvx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcuvx, 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%sfcevp,1)*SIZE(grid%sfcevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcevp, 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 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%snopcx,1)*SIZE(grid%snopcx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%snopcx, 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%sfcuvx,1)*SIZE(grid%sfcuvx,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcuvx, 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%sfcevp,1)*SIZE(grid%sfcevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sfcevp, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_33_sub SUBROUTINE HALO_NMM_INIT_34_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_34_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, & 0, 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& )) IF ( SIZE(grid%potevp,1)*SIZE(grid%potevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%potevp, 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%aswin,1)*SIZE(grid%aswin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswin, 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%aswout,1)*SIZE(grid%aswout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswout, 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 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%potevp,1)*SIZE(grid%potevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%potevp, 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%aswin,1)*SIZE(grid%aswin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswin, 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%aswout,1)*SIZE(grid%aswout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswout, 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 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, & 0, 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& )) IF ( SIZE(grid%potevp,1)*SIZE(grid%potevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%potevp, 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%aswin,1)*SIZE(grid%aswin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswin, 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%aswout,1)*SIZE(grid%aswout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswout, 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 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%potevp,1)*SIZE(grid%potevp,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%potevp, 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%aswin,1)*SIZE(grid%aswin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswin, 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%aswout,1)*SIZE(grid%aswout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswout, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_34_sub SUBROUTINE HALO_NMM_INIT_35_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_35_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, & 0, 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& )) IF ( SIZE(grid%aswtoa,1)*SIZE(grid%aswtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswtoa, 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%alwin,1)*SIZE(grid%alwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwin, 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%alwout,1)*SIZE(grid%alwout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwout, 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 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%aswtoa,1)*SIZE(grid%aswtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswtoa, 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%alwin,1)*SIZE(grid%alwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwin, 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%alwout,1)*SIZE(grid%alwout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwout, 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 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, & 0, 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& )) IF ( SIZE(grid%aswtoa,1)*SIZE(grid%aswtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswtoa, 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%alwin,1)*SIZE(grid%alwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwin, 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%alwout,1)*SIZE(grid%alwout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwout, 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 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%aswtoa,1)*SIZE(grid%aswtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%aswtoa, 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%alwin,1)*SIZE(grid%alwin,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwin, 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%alwout,1)*SIZE(grid%alwout,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwout, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_35_sub SUBROUTINE HALO_NMM_INIT_36_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_INIT_36_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, & 1, 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& ,config_flags%num_soil_layers & )) IF ( SIZE(grid%alwtoa,1)*SIZE(grid%alwtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwtoa, 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%smc,1)*SIZE(grid%smc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%cmc,1)*SIZE(grid%cmc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cmc, 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 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%alwtoa,1)*SIZE(grid%alwtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwtoa, 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%smc,1)*SIZE(grid%smc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%cmc,1)*SIZE(grid%cmc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cmc, 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 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, & 1, 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& ,config_flags%num_soil_layers & )) IF ( SIZE(grid%alwtoa,1)*SIZE(grid%alwtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwtoa, 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%smc,1)*SIZE(grid%smc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%cmc,1)*SIZE(grid%cmc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cmc, 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 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%alwtoa,1)*SIZE(grid%alwtoa,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%alwtoa, 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%smc,1)*SIZE(grid%smc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%smc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%cmc,1)*SIZE(grid%cmc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cmc, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_36_sub SUBROUTINE HALO_NMM_INIT_37_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_INIT_37_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, & 2, 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& ,config_flags%num_soil_layers & )) IF ( SIZE(grid%stc,1)*SIZE(grid%stc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%stc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%sh2o,1)*SIZE(grid%sh2o,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sh2o, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%albedo,1)*SIZE(grid%albedo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%albedo, 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 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%stc,1)*SIZE(grid%stc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%stc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%sh2o,1)*SIZE(grid%sh2o,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sh2o, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%albedo,1)*SIZE(grid%albedo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%albedo, 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 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, & 2, 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& ,config_flags%num_soil_layers & )) IF ( SIZE(grid%stc,1)*SIZE(grid%stc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%stc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%sh2o,1)*SIZE(grid%sh2o,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sh2o, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%albedo,1)*SIZE(grid%albedo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%albedo, 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 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%stc,1)*SIZE(grid%stc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%stc, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%sh2o,1)*SIZE(grid%sh2o,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%sh2o, 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_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_soil_layers, & ims, ime, jms, jme, 1, config_flags%num_soil_layers, & ips, ipe, jps, jpe, 1, config_flags%num_soil_layers ) ENDIF IF ( SIZE(grid%albedo,1)*SIZE(grid%albedo,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%albedo, 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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_37_sub SUBROUTINE HALO_NMM_INIT_38_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_38_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%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 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%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 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%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 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%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 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%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 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%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 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%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 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%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 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%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 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%pint,1)*SIZE(grid%pint,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pint, 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%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 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%dwdt,1)*SIZE(grid%dwdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dwdt, 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_38_sub SUBROUTINE HALO_NMM_INIT_39_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_39_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%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%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 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%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%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 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%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%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 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%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%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 ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_NMM_INIT_39_sub SUBROUTINE HALO_NMM_INIT_40_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_40_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%dthcudt,1)*SIZE(grid%dthcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dthcudt, 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%dqvcudt,1)*SIZE(grid%dqvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqvcudt, 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%dqccudt,1)*SIZE(grid%dqccudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqccudt, 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%dthcudt,1)*SIZE(grid%dthcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dthcudt, 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%dqvcudt,1)*SIZE(grid%dqvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqvcudt, 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%dqccudt,1)*SIZE(grid%dqccudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqccudt, 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%dthcudt,1)*SIZE(grid%dthcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dthcudt, 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%dqvcudt,1)*SIZE(grid%dqvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqvcudt, 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%dqccudt,1)*SIZE(grid%dqccudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqccudt, 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%dthcudt,1)*SIZE(grid%dthcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dthcudt, 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%dqvcudt,1)*SIZE(grid%dqvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqvcudt, 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%dqccudt,1)*SIZE(grid%dqccudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dqccudt, 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_40_sub END MODULE module_comm_dm_1