SUBROUTINE shift_domain_em ( grid , disp_x, disp_y & ! # include ! ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_domain_type, ONLY : fieldlist USE module_timing USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec #ifdef DM_PARALLEL USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, itrace USE module_comm_dm, ONLY : SHIFT_HALO_sub #else USE module_dm #endif IMPLICIT NONE ! Arguments INTEGER disp_x, disp_y ! number of parent domain points to move TYPE(domain) , POINTER :: grid ! Local INTEGER i, j, ii, ipf INTEGER px, py ! number and direction of nd points to move INTEGER :: ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & ips , ipe , jps , jpe , kps , kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 TYPE (grid_config_rec_type) :: config_flags TYPE( fieldlist ), POINTER :: p INTERFACE ! need to split this routine to avoid clobbering certain widely used compilers SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y & ! # include ! ) USE module_state_description USE module_domain, ONLY : domain IMPLICIT NONE ! Arguments INTEGER disp_x, disp_y ! number of parent domain points to move TYPE(domain) , POINTER :: grid ! Definitions of dummy arguments to solve #include END SUBROUTINE shift_domain_em2 END INTERFACE ! Definitions of dummy arguments to solve #include #ifdef MOVE_NESTS CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) px = isign(config_flags%parent_grid_ratio,disp_x) py = isign(config_flags%parent_grid_ratio,disp_y) grid%imask_nostag = 1 grid%imask_xstag = 1 grid%imask_ystag = 1 grid%imask_xystag = 1 grid%imask_nostag(ips:min(ide-1,ipe),jps:min(jde-1,jpe)) = 0 grid%imask_xstag(ips:ipe,jps:min(jde-1,jpe)) = 0 grid%imask_ystag(ips:min(ide-1,ipe),jps:jpe) = 0 grid%imask_xystag(ips:ipe,jps:jpe) = 0 ! shift the nest domain in x do ii = 1,abs(disp_x) #include #include "../frame/loop_based_x_shift_code.h" enddo CALL shift_domain_em2 ( grid , disp_x, disp_y & ! # include ! ) #endif END SUBROUTINE shift_domain_em SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y & ! # include ! ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_domain_type, ONLY : fieldlist USE module_timing USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec #ifdef DM_PARALLEL USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, itrace USE module_comm_dm, ONLY : SHIFT_HALO_sub #else USE module_dm #endif IMPLICIT NONE ! Arguments INTEGER disp_x, disp_y ! number of parent domain points to move TYPE(domain) , POINTER :: grid ! Local INTEGER i, j, ii, jpf INTEGER px, py ! number and direction of nd points to move INTEGER :: ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & ips , ipe , jps , jpe , kps , kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 TYPE (grid_config_rec_type) :: config_flags TYPE( fieldlist ), POINTER :: p ! Definitions of dummy arguments to solve #include #ifdef MOVE_NESTS CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) px = isign(config_flags%parent_grid_ratio,disp_x) py = isign(config_flags%parent_grid_ratio,disp_y) ! shift the nest domain in y do ii = 1,abs(disp_y) #include #include "../frame/loop_based_y_shift_code.h" enddo #endif END SUBROUTINE shift_domain_em2