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_NMM_I_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_I_3_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO END SUBROUTINE HALO_NMM_I_3_sub SUBROUTINE HALO_NMM_J_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_J_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 3, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%uz0,1)*SIZE(grid%uz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%vz0,1)*SIZE(grid%vz0,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO END SUBROUTINE HALO_NMM_J_sub SUBROUTINE HALO_NMM_J_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_J_3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO END SUBROUTINE HALO_NMM_J_3_sub SUBROUTINE HALO_NMM_K_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_K_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 7, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%u,1)*SIZE(grid%u,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%u, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%v,1)*SIZE(grid%v,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%v, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%w,1)*SIZE(grid%w,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%w, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%z,1)*SIZE(grid%z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%z, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO END SUBROUTINE HALO_NMM_K_sub SUBROUTINE HALO_NMM_L_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_L_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%t,1)*SIZE(grid%t,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%t, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q,1)*SIZE(grid%q,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%cwm,1)*SIZE(grid%cwm,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%cwm, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%q2,1)*SIZE(grid%q2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%q2, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO END SUBROUTINE HALO_NMM_L_sub SUBROUTINE HALO_NMM_L_3_sub ( grid, & num_moist, & moist, & num_scalar, & scalar, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER, INTENT(IN) :: num_moist real, INTENT(INOUT) :: moist ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) INTEGER, INTENT(IN) :: num_scalar real, INTENT(INOUT) :: scalar ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_L_3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_moist & + num_scalar & , 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,kpe & )) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE(moist,1)*SIZE(moist,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& moist ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE(scalar,1)*SIZE(scalar,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& scalar ( grid%sm31,grid%sm32,grid%sm33,itrace),1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO END SUBROUTINE HALO_NMM_L_3_sub SUBROUTINE HALO_NMM_MG_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_MG_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 1, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ht_gc,1)*SIZE(grid%ht_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ht_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO END SUBROUTINE HALO_NMM_MG_sub SUBROUTINE HALO_NMM_MG2_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_MG2_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0, 2, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%pd,1)*SIZE(grid%pd,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%pd, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF IF ( SIZE(grid%psfc_out,1)*SIZE(grid%psfc_out,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%psfc_out, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XY, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1 , 1 , & ims, ime, jms, jme, 1 , 1 , & ips, ipe, jps, jpe, 1 , 1 ) ENDIF ENDDO END SUBROUTINE HALO_NMM_MG2_sub SUBROUTINE HALO_NMM_MG3_sub ( grid, & config_flags, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid TYPE(grid_config_rec_type) , INTENT(IN) :: config_flags INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_MG3_inline.inc') CALL rsl_comm_iter_init(1,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%num_metgrid_levels & )) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 1, 0, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& ,config_flags%num_metgrid_levels & )) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%p_gc,1)*SIZE(grid%p_gc,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%p_gc, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, 1, config_flags%num_metgrid_levels, & ims, ime, jms, jme, 1, config_flags%num_metgrid_levels, & ips, ipe, jps, jpe, 1, config_flags%num_metgrid_levels ) ENDIF ENDDO END SUBROUTINE HALO_NMM_MG3_sub SUBROUTINE HALO_NMM_TURBL_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 wrf_debug(2,'calling inc/HALO_NMM_TURBL_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, & 0, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 1,& rsl_sendbeg_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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 1,& rsl_sendbeg_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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 1,& rsl_sendbeg_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%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 1,& rsl_sendbeg_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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 1,& rsl_sendbeg_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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 1,& rsl_sendbeg_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, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 1,& rsl_sendbeg_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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 1,& rsl_sendbeg_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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 1,& rsl_sendbeg_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%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 1,& rsl_sendbeg_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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 1,& rsl_sendbeg_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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 1,& rsl_sendbeg_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 END SUBROUTINE HALO_NMM_TURBL_A_sub SUBROUTINE HALO_NMM_TURBL_B_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_TURBL_B_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%dudt,1)*SIZE(grid%dudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dudt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvdt,1)*SIZE(grid%dvdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvdt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%dudt,1)*SIZE(grid%dudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dudt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvdt,1)*SIZE(grid%dvdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvdt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(1,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 1 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 1, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 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%dudt,1)*SIZE(grid%dudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dudt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvdt,1)*SIZE(grid%dvdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvdt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%dudt,1)*SIZE(grid%dudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dudt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvdt,1)*SIZE(grid%dvdt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvdt, 1,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO END SUBROUTINE HALO_NMM_TURBL_B_sub SUBROUTINE HALO_NMM_SAS_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 wrf_debug(2,'calling inc/HALO_NMM_SAS_A_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, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 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%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 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, 3, 4, & 0, 0, 4, & 0, 0, 8, & 0, 0, 4, & mytask, ntasks, ntasks_x, ntasks_y, & ips, ipe, jps, jpe, kps, MAX(1,1& )) IF ( SIZE(grid%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 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%uz0h,1)*SIZE(grid%uz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%uz0h, 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%vz0h,1)*SIZE(grid%vz0h,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%vz0h, 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%hbm2,1)*SIZE(grid%hbm2,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%hbm2, 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 END SUBROUTINE HALO_NMM_SAS_A_sub SUBROUTINE HALO_NMM_SAS_B_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) USE module_domain, ONLY:domain USE module_configure, ONLY:grid_config_rec_type,in_use_for_config USE module_state_description, ONLY:PARAM_FIRST_SCALAR USE module_driver_constants TYPE(domain) , INTENT(IN) :: grid INTEGER , INTENT(IN) :: local_communicator INTEGER , INTENT(IN) :: mytask, ntasks, ntasks_x, ntasks_y INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER , INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER :: itrace INTEGER :: rsl_sendw_p, rsl_sendbeg_p, rsl_recvw_p, rsl_recvbeg_p INTEGER :: rsl_sendw_m, rsl_sendbeg_m, rsl_recvw_m, rsl_recvbeg_m LOGICAL, EXTERNAL :: rsl_comm_iter INTEGER :: idim1, idim2, idim3, idim4, idim5, idim6, idim7 CALL wrf_debug(2,'calling inc/HALO_NMM_SAS_B_inline.inc') CALL rsl_comm_iter_init(2,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 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%ducudt,1)*SIZE(grid%ducudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ducudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvcudt,1)*SIZE(grid%dvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvcudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ducudt,1)*SIZE(grid%ducudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ducudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvcudt,1)*SIZE(grid%dvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvcudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL rsl_comm_iter_init(2,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 2 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 2, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 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%ducudt,1)*SIZE(grid%ducudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ducudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvcudt,1)*SIZE(grid%dvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvcudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) IF ( SIZE(grid%ducudt,1)*SIZE(grid%ducudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%ducudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF IF ( SIZE(grid%dvcudt,1)*SIZE(grid%dvcudt,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& grid%dvcudt, 2,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO END SUBROUTINE HALO_NMM_SAS_B_sub SUBROUTINE HALO_TRACERS_sub ( grid, & num_szj, & szj, & num_s1z, & s1z, & num_spz, & spz, & num_tcs, & tcs, & 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_szj real, INTENT(INOUT) :: szj ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_szj) INTEGER, INTENT(IN) :: num_s1z real, INTENT(INOUT) :: s1z ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_s1z) INTEGER, INTENT(IN) :: num_spz real, INTENT(INOUT) :: spz ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_spz) INTEGER, INTENT(IN) :: num_tcs real, INTENT(INOUT) :: tcs ( grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tcs) 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 wrf_debug(2,'calling inc/HALO_TRACERS_inline.inc') CALL rsl_comm_iter_init(3,jps,jpe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 0 , jds,jde,jps,jpe, grid%njds, grid%njde , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 0, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_szj & + num_s1z & + num_spz & + num_tcs & , 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_szj IF ( SIZE(szj,1)*SIZE(szj,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& szj ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_s1z IF ( SIZE(s1z,1)*SIZE(s1z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& s1z ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_spz IF ( SIZE(spz,1)*SIZE(spz,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& spz ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tcs IF ( SIZE(tcs,1)*SIZE(tcs,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& tcs ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_Y ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_szj IF ( SIZE(szj,1)*SIZE(szj,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& szj ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_s1z IF ( SIZE(s1z,1)*SIZE(s1z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& s1z ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_spz IF ( SIZE(spz,1)*SIZE(spz,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& spz ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tcs IF ( SIZE(tcs,1)*SIZE(tcs,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& tcs ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 0, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO CALL rsl_comm_iter_init(3,ips,ipe) DO WHILE ( rsl_comm_iter( grid%id , grid%is_intermediate, 3 , & 1 , ids,ide,ips,ipe, grid%nids, grid%nide , & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p )) CALL RSL_LITE_INIT_EXCH ( local_communicator, 3, 1, & rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 0 & + num_szj & + num_s1z & + num_spz & + num_tcs & , 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_szj IF ( SIZE(szj,1)*SIZE(szj,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& szj ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_s1z IF ( SIZE(s1z,1)*SIZE(s1z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& s1z ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_spz IF ( SIZE(spz,1)*SIZE(spz,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& spz ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tcs IF ( SIZE(tcs,1)*SIZE(tcs,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& tcs ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 0, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO CALL RSL_LITE_EXCH_X ( local_communicator , mytask, ntasks, ntasks_x, ntasks_y, & rsl_sendw_m, rsl_sendw_p, rsl_recvw_m, rsl_recvw_p ) DO itrace = PARAM_FIRST_SCALAR, num_szj IF ( SIZE(szj,1)*SIZE(szj,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& szj ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_s1z IF ( SIZE(s1z,1)*SIZE(s1z,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& s1z ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_spz IF ( SIZE(spz,1)*SIZE(spz,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& spz ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tcs IF ( SIZE(tcs,1)*SIZE(tcs,2) .GT. 1 ) THEN CALL RSL_LITE_PACK ( local_communicator,& tcs ( grid%sm31,grid%sm32,grid%sm33,itrace),3,& rsl_sendbeg_m, rsl_sendw_m, rsl_sendbeg_p, rsl_sendw_p, & rsl_recvbeg_m, rsl_recvw_m, rsl_recvbeg_p, rsl_recvw_p, & 4, 1, 1, DATA_ORDER_XYZ, 0, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) ENDIF ENDDO ENDDO END SUBROUTINE HALO_TRACERS_sub END MODULE module_comm_dm_3