shift_domain_em.F
References to this file elsewhere.
1 SUBROUTINE shift_domain_em ( grid , disp_x, disp_y &
2 !
3 # include <em_dummy_new_args.inc>
4 !
5 )
6 USE module_domain
7 USE module_timing
8 USE module_configure
9 USE module_dm
10 USE module_timing
11 IMPLICIT NONE
12 ! Arguments
13 INTEGER disp_x, disp_y ! number of parent domain points to move
14 TYPE(domain) , POINTER :: grid
15 ! Local
16 INTEGER i, j, ii
17 INTEGER px, py ! number and direction of nd points to move
18 INTEGER :: ids , ide , jds , jde , kds , kde , &
19 ims , ime , jms , jme , kms , kme , &
20 ips , ipe , jps , jpe , kps , kpe
21 TYPE (grid_config_rec_type) :: config_flags
22
23 INTERFACE
24 ! need to split this routine to avoid clobbering certain widely used compilers
25 SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
26 !
27 # include <em_dummy_new_args.inc>
28 !
29 )
30 USE module_domain
31 USE module_timing
32 USE module_configure
33 USE module_dm
34 USE module_timing
35 IMPLICIT NONE
36 ! Arguments
37 INTEGER disp_x, disp_y ! number of parent domain points to move
38 TYPE(domain) , POINTER :: grid
39 TYPE (grid_config_rec_type) :: config_flags
40
41 ! Definitions of dummy arguments to solve
42 #include <em_dummy_new_decl.inc>
43 END SUBROUTINE shift_domain_em2
44 END INTERFACE
45
46 ! Definitions of dummy arguments to solve
47 #include <em_dummy_new_decl.inc>
48
49 #ifdef MOVE_NESTS
50 #ifdef DM_PARALLEL
51 # include <em_data_calls.inc>
52 #endif
53
54 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
55
56 CALL get_ijk_from_grid ( grid , &
57 ids, ide, jds, jde, kds, kde, &
58 ims, ime, jms, jme, kms, kme, &
59 ips, ipe, jps, jpe, kps, kpe )
60
61 px = isign(config_flags%parent_grid_ratio,disp_x)
62 py = isign(config_flags%parent_grid_ratio,disp_y)
63
64 grid%imask_nostag = 1
65 grid%imask_xstag = 1
66 grid%imask_ystag = 1
67 grid%imask_xystag = 1
68
69 grid%imask_nostag(ips:min(ide-1,ipe),jps:min(jde-1,jpe)) = 0
70 grid%imask_xstag(ips:ipe,jps:min(jde-1,jpe)) = 0
71 grid%imask_ystag(ips:min(ide-1,ipe),jps:jpe) = 0
72 grid%imask_xystag(ips:ipe,jps:jpe) = 0
73
74 ! shift the nest domain in x
75 do ii = 1,abs(disp_x)
76 #include <em_shift_halo_x.inc>
77 enddo
78
79 CALL shift_domain_em2 ( grid , disp_x, disp_y &
80 !
81 # include <em_dummy_new_args.inc>
82 !
83 )
84
85 #endif
86
87 END SUBROUTINE shift_domain_em
88
89 SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
90 !
91 # include <em_dummy_new_args.inc>
92 !
93 )
94 USE module_domain
95 USE module_timing
96 USE module_configure
97 USE module_dm
98 USE module_timing
99 IMPLICIT NONE
100 ! Arguments
101 INTEGER disp_x, disp_y ! number of parent domain points to move
102 TYPE(domain) , POINTER :: grid
103 ! Local
104 INTEGER i, j, ii
105 INTEGER px, py ! number and direction of nd points to move
106 INTEGER :: ids , ide , jds , jde , kds , kde , &
107 ims , ime , jms , jme , kms , kme , &
108 ips , ipe , jps , jpe , kps , kpe
109 TYPE (grid_config_rec_type) :: config_flags
110
111 ! Definitions of dummy arguments to solve
112 #include <em_dummy_new_decl.inc>
113
114 #ifdef MOVE_NESTS
115
116 #ifdef DM_PARALLEL
117 # include <em_data_calls.inc>
118 #endif
119
120 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
121
122 CALL get_ijk_from_grid ( grid , &
123 ids, ide, jds, jde, kds, kde, &
124 ims, ime, jms, jme, kms, kme, &
125 ips, ipe, jps, jpe, kps, kpe )
126
127 px = isign(config_flags%parent_grid_ratio,disp_x)
128 py = isign(config_flags%parent_grid_ratio,disp_y)
129
130 ! shift the nest domain in y
131 do ii = 1,abs(disp_y)
132 #include <em_shift_halo_y.inc>
133 enddo
134
135 #endif
136 END SUBROUTINE shift_domain_em2
137