da_solve_init.inc
References to this file elsewhere.
1 subroutine da_solve_init(grid &
2 #include "em_dummy_new_args.inc"
3 )
4
5 !-----------------------------------------------------------------------
6 ! Purpose: TBD
7 !-----------------------------------------------------------------------
8
9 implicit none
10
11 type(domain), intent(inout) :: grid
12
13 #include "em_dummy_new_decl.inc"
14
15 #ifdef DM_PARALLEL
16 integer :: ii
17 #endif
18
19 integer :: sm31,sm32,sm33,sm31x,sm32x,sm33x,sm31y,sm32y,sm33y
20
21 ! if (dwordsize != rwordsize)
22 #define true_MSG_XPOSE add_msg_xpose_real
23 ! else
24 ! define true_MSG_XPOSE add_msg_xpose_doubleprecision
25 ! end if
26
27 if (trace_use) call da_trace_entry("da_solve_init")
28
29 ! De-reference dimension information stored in the grid data structure.
30
31 call da_copy_dims(grid)
32
33 ! Compute these starting and stopping locations for each tile and number
34 ! of tiles.
35
36 call set_tiles (grid , ids , ide , jds , jde , ips , ipe , jps , jpe)
37
38 call da_copy_tile_dims(grid)
39
40 sm31 = grid%sm31
41 sm32 = grid%sm32
42 sm33 = grid%sm33
43 sm31x = grid%sm31x
44 sm32x = grid%sm32x
45 sm33x = grid%sm33x
46 sm31y = grid%sm31y
47 sm32y = grid%sm32y
48 sm33y = grid%sm33y
49
50 #ifdef DM_PARALLEL
51 if (trace_use) call da_trace("da_solve_init", &
52 Message="Setup register xpose arrays")
53
54 ! Register xpose arrays and build messages for processor communication.
55 #define REGISTER_I1
56 #include "em_data_calls.inc"
57 ! XPOSE_V1
58 if (grid%comms(XPOSE_V1) == invalid_message_value) then
59 call setup_xpose_rsl(grid)
60 call reset_msgs_xpose
61 call true_MSG_XPOSE (grid%xp%v1z, grid%xp%v1x, grid%xp%v1y, 3)
62 call define_xpose (grid%domdesc , grid%comms (XPOSE_V1))
63 end if
64
65 ! XPOSE_V2
66 if (grid%comms(XPOSE_V2) == invalid_message_value) then
67 call setup_xpose_rsl(grid)
68 call reset_msgs_xpose
69 call true_MSG_XPOSE (grid%xp%v2z, grid%xp%v2x, grid%xp%v2y, 3)
70 call define_xpose (grid%domdesc , grid%comms (XPOSE_V2))
71 end if
72
73 if (trace_use) call da_trace("da_solve_init", &
74 Message="Setup halo region communication")
75
76 ! Define halo region communication.
77 !-----------------------------------------------------------------------
78 ! Stencils for patch communications
79 ! * * * * *
80 ! * * * * * * * * *
81 ! * + * * + * * * + * *
82 ! * * * * * * * * *
83 ! * * * * *
84 !ij vp%v1 x
85 !ij xb%cori x
86 !ij xb%rho x
87 !ij xa%u x
88 !ij xa%v x
89 !--------------------------------------------------------------
90 #include "HALO_INIT.inc"
91 #include "HALO_PSICHI_UV.inc"
92 #include "HALO_BAL_EQN_ADJ.inc"
93 #include "HALO_PSICHI_UV_ADJ.inc"
94 #include "HALO_XA.inc"
95 #include "HALO_XB.inc"
96 #include "HALO_SFC_XA.inc"
97 #include "HALO_SFC_XB.inc"
98 #include "HALO_SSMI_XA.inc"
99 #include "HALO_SSMI_XB.inc"
100 #include "HALO_RADAR_XB.inc"
101 #include "HALO_RADAR_XB.inc"
102 #include "HALO_2D_WORK.inc"
103 #include "HALO_RADAR_XA_W.inc"
104
105 if (trace_use) call da_trace("da_solve_init", &
106 Message="Copy domain and transpose descriptors")
107
108 ! Copy domain and transpose descriptors.
109
110 grid%xp%domdesc = grid%domdesc
111 do ii = 1, max_comms
112 grid%xp%comms(ii) = grid%comms(ii)
113 end do
114
115 ! Copy halo and transpose IDs.
116
117 grid%xp%halo_id0 = HALO_INIT
118 grid%xp%halo_id1 = HALO_PSICHI_UV
119 grid%xp%halo_id2 = HALO_BAL_EQN_ADJ
120 grid%xp%halo_id3 = HALO_PSICHI_UV_ADJ
121 grid%xp%halo_id4 = HALO_XA
122 grid%xp%halo_id5 = HALO_XB
123 grid%xp%halo_id6 = HALO_SFC_XA
124 grid%xp%halo_id7 = HALO_SFC_XB
125 grid%xp%halo_id8 = HALO_SSMI_XA
126 grid%xp%halo_id9 = HALO_SSMI_XB
127 grid%xp%halo_id10 = HALO_RADAR_XA
128 grid%xp%halo_id11 = HALO_RADAR_XB
129 grid%xp%halo_id12 = HALO_2D_WORK
130 grid%xp%halo_id13 = HALO_RADAR_XA_W
131
132 grid%xp%xpose_id1 = XPOSE_V1
133 grid%xp%xpose_id2 = XPOSE_V2
134 #endif
135
136 ! Fill background scalars:
137
138 grid%xb%ids = grid%xp%ids
139 grid%xb%ide = grid%xp%ide
140 grid%xb%jds = grid%xp%jds
141 grid%xb%jde = grid%xp%jde
142 grid%xb%kds = grid%xp%kds
143 grid%xb%kde = grid%xp%kde
144
145 grid%xb%ims = grid%xp%ims
146 grid%xb%ime = grid%xp%ime
147 grid%xb%jms = grid%xp%jms
148 grid%xb%jme = grid%xp%jme
149 grid%xb%kms = grid%xp%kms
150 grid%xb%kme = grid%xp%kme
151
152 grid%xb%its = grid%xp%its
153 grid%xb%ite = grid%xp%ite
154 grid%xb%jts = grid%xp%jts
155 grid%xb%jte = grid%xp%jte
156 grid%xb%kts = grid%xp%kts
157 grid%xb%kte = grid%xp%kte
158
159 if (trace_use) call da_trace_exit("da_solve_init")
160
161 end subroutine da_solve_init
162
163