MODULE module_comm_dm_3 IMPLICIT NONE PRIVATE module_comm_dm_dummy_3 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_3 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_3 SUBROUTINE HALO_PWP_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_PWP_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%ocean_levels & )) IF ( SIZE(grid%om_tmp,1)*SIZE(grid%om_tmp,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tmp, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_s,1)*SIZE(grid%om_s,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_s, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_u,1)*SIZE(grid%om_u,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_u, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_v,1)*SIZE(grid%om_v,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_v, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_depth,1)*SIZE(grid%om_depth,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_depth, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_tini,1)*SIZE(grid%om_tini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_sini,1)*SIZE(grid%om_sini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_sini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%om_tmp,1)*SIZE(grid%om_tmp,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tmp, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_s,1)*SIZE(grid%om_s,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_s, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_u,1)*SIZE(grid%om_u,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_u, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_v,1)*SIZE(grid%om_v,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_v, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_depth,1)*SIZE(grid%om_depth,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_depth, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_tini,1)*SIZE(grid%om_tini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_sini,1)*SIZE(grid%om_sini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_sini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%ocean_levels & )) IF ( SIZE(grid%om_tmp,1)*SIZE(grid%om_tmp,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tmp, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_s,1)*SIZE(grid%om_s,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_s, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_u,1)*SIZE(grid%om_u,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_u, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_v,1)*SIZE(grid%om_v,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_v, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_depth,1)*SIZE(grid%om_depth,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_depth, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_tini,1)*SIZE(grid%om_tini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_sini,1)*SIZE(grid%om_sini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_sini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%om_tmp,1)*SIZE(grid%om_tmp,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tmp, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_s,1)*SIZE(grid%om_s,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_s, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_u,1)*SIZE(grid%om_u,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_u, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_v,1)*SIZE(grid%om_v,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_v, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_depth,1)*SIZE(grid%om_depth,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_depth, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_tini,1)*SIZE(grid%om_tini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_tini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF IF ( SIZE(grid%om_sini,1)*SIZE(grid%om_sini,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%om_sini, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%ocean_levels, & ims, ime, jms, jme, 1, config_flags%ocean_levels, & ips, ipe, jps, jpe, 1, config_flags%ocean_levels ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_PWP_sub SUBROUTINE HALO_FIRE_MFG_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_FIRE_MFG_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%fmc_g,1)*SIZE(grid%fmc_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_g, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%fmc_g,1)*SIZE(grid%fmc_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_g, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%fmc_g,1)*SIZE(grid%fmc_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_g, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%fmc_g,1)*SIZE(grid%fmc_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_g, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_MFG_sub SUBROUTINE HALO_FIRE_MAG_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_FIRE_MAG_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%nfmc & )) IF ( SIZE(grid%fmc_gc,1)*SIZE(grid%fmc_gc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%nfmc, & ims, ime, jms, jme, 1, config_flags%nfmc, & ips, ipe, jps, jpe, 1, config_flags%nfmc ) 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%fmc_gc,1)*SIZE(grid%fmc_gc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%nfmc, & ims, ime, jms, jme, 1, config_flags%nfmc, & ips, ipe, jps, jpe, 1, config_flags%nfmc ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%nfmc & )) IF ( SIZE(grid%fmc_gc,1)*SIZE(grid%fmc_gc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%nfmc, & ims, ime, jms, jme, 1, config_flags%nfmc, & ips, ipe, jps, jpe, 1, config_flags%nfmc ) 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%fmc_gc,1)*SIZE(grid%fmc_gc,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fmc_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%nfmc, & ims, ime, jms, jme, 1, config_flags%nfmc, & ips, ipe, jps, jpe, 1, config_flags%nfmc ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_MAG_sub SUBROUTINE HALO_FIRE_LFN_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_FIRE_LFN_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn,1)*SIZE(grid%lfn,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn,1)*SIZE(grid%lfn,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn,1)*SIZE(grid%lfn,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn,1)*SIZE(grid%lfn,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_sub SUBROUTINE HALO_FIRE_LFN_0_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_FIRE_LFN_0_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_0,1)*SIZE(grid%lfn_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_0, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_0,1)*SIZE(grid%lfn_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_0, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_0,1)*SIZE(grid%lfn_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_0, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_0,1)*SIZE(grid%lfn_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_0, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_0_sub SUBROUTINE HALO_FIRE_LFN_1_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_FIRE_LFN_1_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_1,1)*SIZE(grid%lfn_1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_1,1)*SIZE(grid%lfn_1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_1,1)*SIZE(grid%lfn_1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_1,1)*SIZE(grid%lfn_1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_1_sub SUBROUTINE HALO_FIRE_LFN_2_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_FIRE_LFN_2_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_2,1)*SIZE(grid%lfn_2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_2,1)*SIZE(grid%lfn_2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_2,1)*SIZE(grid%lfn_2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_2,1)*SIZE(grid%lfn_2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_2_sub SUBROUTINE HALO_FIRE_LFN_S1_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_FIRE_LFN_S1_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s1,1)*SIZE(grid%lfn_s1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s1,1)*SIZE(grid%lfn_s1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s1,1)*SIZE(grid%lfn_s1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s1,1)*SIZE(grid%lfn_s1,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s1, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_S1_sub SUBROUTINE HALO_FIRE_LFN_S2_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_FIRE_LFN_S2_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s2,1)*SIZE(grid%lfn_s2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s2,1)*SIZE(grid%lfn_s2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s2,1)*SIZE(grid%lfn_s2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s2,1)*SIZE(grid%lfn_s2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s2, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_S2_sub SUBROUTINE HALO_FIRE_LFN_S3_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_FIRE_LFN_S3_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s3,1)*SIZE(grid%lfn_s3,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s3, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s3,1)*SIZE(grid%lfn_s3,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s3, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%lfn_s3,1)*SIZE(grid%lfn_s3,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s3, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%lfn_s3,1)*SIZE(grid%lfn_s3,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%lfn_s3, 3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_LFN_S3_sub SUBROUTINE HALO_FIRE_TIGN_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_FIRE_TIGN_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%tign_g,1)*SIZE(grid%tign_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tign_g, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%tign_g,1)*SIZE(grid%tign_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tign_g, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%tign_g,1)*SIZE(grid%tign_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tign_g, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%tign_g,1)*SIZE(grid%tign_g,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tign_g, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_TIGN_sub SUBROUTINE HALO_FIRE_HT_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_FIRE_HT_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht,1)*SIZE(grid%ht,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht,1)*SIZE(grid%ht,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht,1)*SIZE(grid%ht,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht,1)*SIZE(grid%ht,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_HT_sub SUBROUTINE HALO_FIRE_PHB_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_FIRE_PHB_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%phb,1)*SIZE(grid%phb,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, 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%phb,1)*SIZE(grid%phb,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%phb,1)*SIZE(grid%phb,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, 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%phb,1)*SIZE(grid%phb,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, 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_FIRE_PHB_sub SUBROUTINE HALO_FIRE_Z0_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_FIRE_Z0_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%z0,1)*SIZE(grid%z0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%z0,1)*SIZE(grid%z0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%z0,1)*SIZE(grid%z0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%z0,1)*SIZE(grid%z0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_Z0_sub SUBROUTINE HALO_FIRE_PH_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_FIRE_PH_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%ph_2,1)*SIZE(grid%ph_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ph_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, 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%ph_2,1)*SIZE(grid%ph_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ph_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%ph_2,1)*SIZE(grid%ph_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ph_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, 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%ph_2,1)*SIZE(grid%ph_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ph_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, 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_FIRE_PH_sub SUBROUTINE HALO_FIRE_WIND_F_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_FIRE_WIND_F_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%uf,1)*SIZE(grid%uf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%vf,1)*SIZE(grid%vf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%uf,1)*SIZE(grid%uf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%vf,1)*SIZE(grid%vf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%uf,1)*SIZE(grid%uf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%vf,1)*SIZE(grid%vf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%uf,1)*SIZE(grid%uf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%vf,1)*SIZE(grid%vf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_WIND_F_sub SUBROUTINE HALO_FIRE_LONGLAT_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_FIRE_LONGLAT_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 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%xlong,1)*SIZE(grid%xlong,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlong, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_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%xlat,1)*SIZE(grid%xlat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlat, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_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%xlong,1)*SIZE(grid%xlong,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlong, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_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%xlat,1)*SIZE(grid%xlat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlat, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_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(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 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%xlong,1)*SIZE(grid%xlong,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlong, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_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%xlat,1)*SIZE(grid%xlat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlat, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_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%xlong,1)*SIZE(grid%xlong,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlong, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_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%xlat,1)*SIZE(grid%xlat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%xlat, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_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_FIRE_LONGLAT_sub SUBROUTINE HALO_FIRE_WIND_A_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL push_communicators_for_domain( grid%id ) CALL wrf_debug(2,'calling inc/HALO_FIRE_WIND_A_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u_2,1)*SIZE(grid%u_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v_2,1)*SIZE(grid%v_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 1, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u_2,1)*SIZE(grid%u_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v_2,1)*SIZE(grid%v_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 1, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 2, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%u_2,1)*SIZE(grid%u_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 1, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v_2,1)*SIZE(grid%v_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%u_2,1)*SIZE(grid%u_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 1, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v_2,1)*SIZE(grid%v_2,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v_2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, 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_FIRE_WIND_A_sub SUBROUTINE HALO_FIRE_ZSF_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_FIRE_ZSF_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%zsf,1)*SIZE(grid%zsf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%zsf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%zsf,1)*SIZE(grid%zsf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%zsf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%zsf,1)*SIZE(grid%zsf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%zsf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%zsf,1)*SIZE(grid%zsf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%zsf, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_ZSF_sub SUBROUTINE HALO_FIRE_FUEL_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_FIRE_FUEL_inline.inc') IF ( grid%sr_y .GT. 0 ) THEN CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 11, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%fuel_frac,1)*SIZE(grid%fuel_frac,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_frac, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fuel_time,1)*SIZE(grid%fuel_time,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_time, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%bbb,1)*SIZE(grid%bbb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bbb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%betafl,1)*SIZE(grid%betafl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%betafl, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%phiwc,1)*SIZE(grid%phiwc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phiwc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%r_0,1)*SIZE(grid%r_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%r_0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fgip,1)*SIZE(grid%fgip,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fgip, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%ischap,1)*SIZE(grid%ischap,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ischap, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%nfuel_cat,1)*SIZE(grid%nfuel_cat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%nfuel_cat, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdxf,1)*SIZE(grid%dzdxf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdxf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdyf,1)*SIZE(grid%dzdyf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdyf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%fuel_frac,1)*SIZE(grid%fuel_frac,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_frac, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fuel_time,1)*SIZE(grid%fuel_time,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_time, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%bbb,1)*SIZE(grid%bbb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bbb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%betafl,1)*SIZE(grid%betafl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%betafl, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%phiwc,1)*SIZE(grid%phiwc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phiwc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%r_0,1)*SIZE(grid%r_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%r_0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fgip,1)*SIZE(grid%fgip,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fgip, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%ischap,1)*SIZE(grid%ischap,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ischap, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%nfuel_cat,1)*SIZE(grid%nfuel_cat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%nfuel_cat, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdxf,1)*SIZE(grid%dzdxf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdxf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdyf,1)*SIZE(grid%dzdyf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdyf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 11, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,kps,kpe) IF ( SIZE(grid%fuel_frac,1)*SIZE(grid%fuel_frac,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_frac, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fuel_time,1)*SIZE(grid%fuel_time,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_time, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%bbb,1)*SIZE(grid%bbb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bbb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%betafl,1)*SIZE(grid%betafl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%betafl, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%phiwc,1)*SIZE(grid%phiwc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phiwc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%r_0,1)*SIZE(grid%r_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%r_0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fgip,1)*SIZE(grid%fgip,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fgip, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%ischap,1)*SIZE(grid%ischap,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ischap, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%nfuel_cat,1)*SIZE(grid%nfuel_cat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%nfuel_cat, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdxf,1)*SIZE(grid%dzdxf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdxf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdyf,1)*SIZE(grid%dzdyf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdyf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,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%fuel_frac,1)*SIZE(grid%fuel_frac,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_frac, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fuel_time,1)*SIZE(grid%fuel_time,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fuel_time, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%bbb,1)*SIZE(grid%bbb,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%bbb, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%betafl,1)*SIZE(grid%betafl,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%betafl, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%phiwc,1)*SIZE(grid%phiwc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%phiwc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%r_0,1)*SIZE(grid%r_0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%r_0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%fgip,1)*SIZE(grid%fgip,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%fgip, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%ischap,1)*SIZE(grid%ischap,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ischap, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%nfuel_cat,1)*SIZE(grid%nfuel_cat,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%nfuel_cat, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdxf,1)*SIZE(grid%dzdxf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdxf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF IF ( SIZE(grid%dzdyf,1)*SIZE(grid%dzdyf,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dzdyf, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide*grid%sr_x, jds, jde*grid%sr_y, kds, kde, & (ims-1)*grid%sr_x+1,ime*grid%sr_x,(jms-1)*grid%sr_y+1,jme*grid%sr_y,1,1,& (ips-1)*grid%sr_x+1,ipe*grid%sr_x,(jps-1)*grid%sr_y+1,jpe*grid%sr_y,1,1) ENDIF ENDDO ENDIF CALL pop_communicators_for_domain END SUBROUTINE HALO_FIRE_FUEL_sub SUBROUTINE HALO_EM_NBA_MIJ_sub ( grid, & num_nba_mij, & nba_mij, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_nba_mij real, INTENT(INOUT) :: nba_mij ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_nba_mij) 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_EM_NBA_MIJ_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_nba_mij & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_nba_mij IF ( SIZE(nba_mij,1)*SIZE(nba_mij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_mij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_nba_mij IF ( SIZE(nba_mij,1)*SIZE(nba_mij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_mij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_nba_mij & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_nba_mij IF ( SIZE(nba_mij,1)*SIZE(nba_mij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_mij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_nba_mij IF ( SIZE(nba_mij,1)*SIZE(nba_mij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_mij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_EM_NBA_MIJ_sub SUBROUTINE HALO_EM_NBA_RIJ_sub ( grid, & num_nba_rij, & nba_rij, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_nba_rij real, INTENT(INOUT) :: nba_rij ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33 ,num_nba_rij) 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_EM_NBA_RIJ_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_nba_rij & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_nba_rij IF ( SIZE(nba_rij,1)*SIZE(nba_rij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_rij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_nba_rij IF ( SIZE(nba_rij,1)*SIZE(nba_rij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_rij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_nba_rij & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_nba_rij IF ( SIZE(nba_rij,1)*SIZE(nba_rij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_rij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_nba_rij IF ( SIZE(nba_rij,1)*SIZE(nba_rij,3) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& nba_rij ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p , rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XZY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_EM_NBA_RIJ_sub SUBROUTINE HALO_EM_PHYS_W_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_EM_PHYS_W_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%tornado_mask,1)*SIZE(grid%tornado_mask,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_mask, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%tornado_dur,1)*SIZE(grid%tornado_dur,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_dur, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%tornado_mask,1)*SIZE(grid%tornado_mask,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_mask, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%tornado_dur,1)*SIZE(grid%tornado_dur,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_dur, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%tornado_mask,1)*SIZE(grid%tornado_mask,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_mask, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%tornado_dur,1)*SIZE(grid%tornado_dur,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_dur, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%tornado_mask,1)*SIZE(grid%tornado_mask,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_mask, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%tornado_dur,1)*SIZE(grid%tornado_dur,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%tornado_dur, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL pop_communicators_for_domain END SUBROUTINE HALO_EM_PHYS_W_sub END MODULE module_comm_dm_3