Line data Source code
1 : module element_mod
2 :
3 : use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8
4 : use coordinate_systems_mod, only: spherical_polar_t, cartesian2D_t, cartesian3D_t, distance
5 : use dimensions_mod, only: np, nc, npsq, nlev, nlevp, qsize_d, max_neigh_edges,ntrac_d
6 : use edgetype_mod, only: edgedescriptor_t
7 : use gridgraph_mod, only: gridvertex_t
8 :
9 : implicit none
10 : private
11 : integer, public, parameter :: timelevels = 3
12 :
13 :
14 : ! =========== PRIMITIVE-EQUATION DATA-STRUCTURES =====================
15 :
16 : type, public :: elem_state_t
17 :
18 : ! prognostic variables for preqx solver
19 :
20 : ! prognostics must match those in prim_restart_mod.F90
21 : ! vertically-lagrangian code advects dp3d instead of ps
22 : ! tracers Q, Qdp always use 2 level time scheme
23 :
24 : real (kind=r8) :: v (np,np,2,nlev,timelevels) ! velocity
25 : real (kind=r8) :: T (np,np,nlev,timelevels) ! temperature
26 : real (kind=r8) :: dp3d (np,np,nlev,timelevels) ! dry delta p on levels
27 : real (kind=r8) :: psdry (np,np) ! dry surface pressure
28 : real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed)
29 : real (kind=r8), allocatable :: Qdp(:,:,:,:,:) ! Tracer mass
30 : end type elem_state_t
31 :
32 : !___________________________________________________________________
33 : type, public :: derived_state_t
34 : !
35 : ! storage for subcycling tracers/dynamics
36 : !
37 : real (kind=r8) :: vn0 (np,np,2,nlev) ! velocity for SE tracer advection
38 : real (kind=r8) :: dpdiss_biharmonic(np,np,nlev) ! mean dp dissipation tendency, if nu_p>0
39 : real (kind=r8) :: dpdiss_ave(np,np,nlev) ! mean dp used to compute psdiss_tens
40 :
41 : ! diagnostics for explicit timestep
42 : real (kind=r8) :: phi(np,np,nlev) ! geopotential
43 : real (kind=r8) :: omega(np,np,nlev) ! vertical velocity
44 :
45 : ! tracer advection fields used for consistency and limiters
46 : real (kind=r8) :: dp(np,np,nlev) ! for dp_tracers at physics timestep
47 : real (kind=r8), allocatable :: divdp(:,:,:) ! divergence of dp
48 : real (kind=r8), allocatable :: divdp_proj(:,:,:) ! DSSed divdp
49 : real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+9) ! total tracer mass for diagnostics
50 :
51 : ! forcing terms for CAM
52 : real (kind=r8), allocatable :: FQ(:,:,:,:) ! tracer forcing
53 : real (kind=r8) :: FM(np,np,2,nlev) ! momentum forcing
54 : real (kind=r8), allocatable :: FDP(:,:,:) ! save full updated dp right after physics
55 : real (kind=r8) :: FT(np,np,nlev) ! temperature forcing
56 :
57 : ! reference profiles
58 : real (kind=r8) :: T_ref(np,np,nlev) ! reference temperature
59 : real (kind=r8) :: dp_ref(np,np,nlev) ! reference pressure level thickness
60 : end type derived_state_t
61 :
62 : !___________________________________________________________________
63 : type, public :: elem_accum_t
64 :
65 :
66 : ! the "4" timelevels represents data computed at:
67 : ! 1 t-.5
68 : ! 2 t+.5 after dynamics
69 : ! 3 t+.5 after forcing
70 : ! 4 t+.5 after Robert
71 : ! after calling TimeLevelUpdate, all times above decrease by 1.0
72 :
73 :
74 : end type elem_accum_t
75 :
76 :
77 : ! ============= DATA-STRUCTURES COMMON TO ALL SOLVERS ================
78 :
79 : type, public :: index_t
80 : integer :: ia(npsq),ja(npsq)
81 : integer :: is,ie
82 : integer :: NumUniquePts
83 : integer :: UniquePtOffset
84 : end type index_t
85 :
86 : !___________________________________________________________________
87 : type, public :: element_t
88 : integer :: LocalId
89 : integer :: GlobalId
90 :
91 : ! Coordinate values of element points
92 : type (spherical_polar_t) :: spherep(np,np) ! Spherical coords of GLL points
93 :
94 : ! Equ-angular gnomonic projection coordinates
95 : type (cartesian2D_t) :: cartp(np,np) ! gnomonic coords of GLL points
96 : type (cartesian2D_t) :: corners(4) ! gnomonic coords of element corners
97 : real (kind=r8) :: u2qmap(4,2) ! bilinear map from ref element to quad in cubedsphere coordinates
98 : ! SHOULD BE REMOVED
99 : ! 3D cartesian coordinates
100 : type (cartesian3D_t) :: corners3D(4)
101 :
102 : ! Element diagnostics
103 : real (kind=r8) :: area ! Area of element
104 : real (kind=r8) :: normDinv ! some type of norm of Dinv used for CFL
105 : real (kind=r8) :: dx_short ! short length scale in km
106 : real (kind=r8) :: dx_long ! long length scale in km
107 :
108 : real (kind=r8) :: variable_hyperviscosity(np,np) ! hyperviscosity based on above
109 : real (kind=r8) :: hv_courant ! hyperviscosity courant number
110 : real (kind=r8) :: tensorVisc(np,np,2,2) !og, matrix V for tensor viscosity
111 :
112 : ! Edge connectivity information
113 : ! integer :: node_numbers(4)
114 : ! integer :: node_multiplicity(4) ! number of elements sharing corner node
115 :
116 : type (GridVertex_t) :: vertex ! element grid vertex information
117 : type (EdgeDescriptor_t) :: desc
118 :
119 : type (elem_state_t) :: state
120 :
121 : type (derived_state_t) :: derived
122 : ! Metric terms
123 : real (kind=r8) :: met(np,np,2,2) ! metric tensor on velocity and pressure grid
124 : real (kind=r8) :: metinv(np,np,2,2) ! metric tensor on velocity and pressure grid
125 : real (kind=r8) :: metdet(np,np) ! g = SQRT(det(g_ij)) on velocity and pressure grid
126 : real (kind=r8) :: rmetdet(np,np) ! 1/metdet on velocity pressure grid
127 : real (kind=r8) :: D(np,np,2,2) ! Map covariant field on cube to vector field on the sphere
128 : real (kind=r8) :: Dinv(np,np,2,2) ! Map vector field on the sphere to covariant v on cube
129 :
130 :
131 : ! Mass flux across the sides of each sub-element.
132 : ! The storage is redundent since the mass across shared sides
133 : ! must be equal in magnitude and opposite in sign.
134 : ! The layout is like:
135 : ! --------------------------------------------------------------
136 : ! ^| (1,4,3) | | | (4,4,3) |
137 : ! || | | | |
138 : ! ||(1,4,4) | | |(4,4,4) |
139 : ! || (1,4,2)| | | (4,4,2)|
140 : ! || | | | |
141 : ! || (1,4,1) | | | (4,4,1) |
142 : ! |---------------------------------------------------------------
143 : ! S| | | | |
144 : ! e| | | | |
145 : ! c| | | | |
146 : ! o| | | | |
147 : ! n| | | | |
148 : ! d| | | | |
149 : ! ---------------------------------------------------------------
150 : ! C| | | | |
151 : ! o| | | | |
152 : ! o| | | | |
153 : ! r| | | | |
154 : ! d| | | | |
155 : ! i| | | | |
156 : ! n---------------------------------------------------------------
157 : ! a| (1,1,3) | | | (4,1,3) |
158 : ! t| | | |(4,1,4) |
159 : ! e|(1,1,4) | | | |
160 : ! | (1,1,2)| | | (4,1,2)|
161 : ! | | | | |
162 : ! | (1,1,1) | | | (4,1,1) |
163 : ! ---------------------------------------------------------------
164 : ! First Coordinate ------->
165 : real (kind=r8) :: sub_elem_mass_flux(nc,nc,4,nlev)
166 :
167 : ! Convert vector fields from spherical to rectangular components
168 : ! The transpose of this operation is its pseudoinverse.
169 : real (kind=r8) :: vec_sphere2cart(np,np,3,2)
170 :
171 : ! Mass matrix terms for an element on a cube face
172 : real (kind=r8) :: mp(np,np) ! mass matrix on v and p grid
173 : real (kind=r8) :: rmp(np,np) ! inverse mass matrix on v and p grid
174 :
175 : ! Mass matrix terms for an element on the sphere
176 : ! This mass matrix is used when solving the equations in weak form
177 : ! with the natural (surface area of the sphere) inner product
178 : real (kind=r8) :: spheremp(np,np) ! mass matrix on v and p grid
179 : real (kind=r8) :: rspheremp(np,np) ! inverse mass matrix on v and p grid
180 :
181 : integer(i8) :: gdofP(np,np) ! global degree of freedom (P-grid)
182 :
183 : real (kind=r8) :: fcor(np,np) ! Coreolis term
184 :
185 : type (index_t) :: idxP
186 : type (index_t),pointer :: idxV
187 : integer :: FaceNum
188 :
189 : ! force element_t to be a multiple of 8 bytes.
190 : ! on BGP, code will crash (signal 7, or signal 15) if 8 byte alignment is off
191 : ! check core file for:
192 : ! core.63:Generated by interrupt..(Alignment Exception DEAR=0xa1ef671c ESR=0x01800000 CCR0=0x4800a002)
193 : integer :: dummy
194 : end type element_t
195 :
196 : !___________________________________________________________________
197 : public :: element_coordinates
198 : public :: element_var_coordinates
199 : public :: element_var_coordinates3D
200 : public :: GetColumnIdP,GetColumnIdV
201 : public :: allocate_element_desc
202 : public :: PrintElem
203 :
204 : contains
205 :
206 0 : subroutine PrintElem(arr)
207 :
208 : real(kind=r8) :: arr(:,:)
209 : integer :: i,j
210 :
211 0 : do j=np,1,-1
212 0 : write(6,*) (arr(i,j), i=1,np)
213 : enddo
214 :
215 0 : end subroutine PrintElem
216 : ! ===================== ELEMENT_MOD METHODS ==========================
217 :
218 0 : function GetColumnIdP(elem,i,j) result(col_id)
219 :
220 : ! Get unique identifier for a Physics column on the P-grid
221 :
222 : type(element_t), intent(in) :: elem
223 : integer, intent(in) :: i,j
224 : integer :: col_id
225 0 : col_id = elem%gdofP(i,j)
226 0 : end function GetColumnIdP
227 :
228 : !___________________________________________________________________
229 0 : function GetColumnIdV(elem,i,j) result(col_id)
230 :
231 : ! Get unique identifier for a Physics column on the V-grid
232 :
233 : type(element_t), intent(in) :: elem
234 : integer, intent(in) :: i,j
235 : integer :: col_id
236 0 : col_id = elem%gdofP(i,j)
237 0 : end function GetColumnIdV
238 :
239 : !___________________________________________________________________
240 0 : function element_coordinates(start,end,points) result(cart)
241 :
242 : ! Initialize 2D rectilinear element colocation points
243 :
244 : type (cartesian2D_t), intent(in) :: start
245 : type (cartesian2D_t), intent(in) :: end
246 : real(r8), intent(in) :: points(:)
247 : type (cartesian2D_t) :: cart(SIZE(points),SIZE(points))
248 :
249 : type (cartesian2D_t) :: length, centroid
250 : real(r8) :: y
251 : integer :: i,j
252 :
253 0 : length%x = 0.50D0*(end%x-start%x)
254 0 : length%y = 0.50D0*(end%y-start%y)
255 0 : centroid%x = 0.50D0*(end%x+start%x)
256 0 : centroid%y = 0.50D0*(end%y+start%y)
257 0 : do j=1,SIZE(points)
258 0 : y = centroid%y + length%y*points(j)
259 0 : do i=1,SIZE(points)
260 0 : cart(i,j)%x = centroid%x + length%x*points(i)
261 0 : cart(i,j)%y = y
262 : end do
263 : end do
264 0 : end function element_coordinates
265 :
266 : !___________________________________________________________________
267 32400 : function element_var_coordinates(c,points) result(cart)
268 :
269 : type (cartesian2D_t), intent(in) :: c(4)
270 : real(r8), intent(in) :: points(:)
271 : type (cartesian2D_t) :: cart(SIZE(points),SIZE(points))
272 :
273 64800 : real(r8) :: p(size(points))
274 64800 : real(r8) :: q(size(points))
275 : integer :: i,j
276 :
277 194400 : p(:) = (1.0D0-points(:))/2.0D0
278 162000 : q(:) = (1.0D0+points(:))/2.0D0
279 :
280 162000 : do j=1,SIZE(points)
281 680400 : do i=1,SIZE(points)
282 1036800 : cart(i,j)%x = p(i)*p(j)*c(1)%x &
283 : + q(i)*p(j)*c(2)%x &
284 : + q(i)*q(j)*c(3)%x &
285 1036800 : + p(i)*q(j)*c(4)%x
286 : cart(i,j)%y = p(i)*p(j)*c(1)%y &
287 : + q(i)*p(j)*c(2)%y &
288 : + q(i)*q(j)*c(3)%y &
289 648000 : + p(i)*q(j)*c(4)%y
290 : end do
291 : end do
292 32400 : end function element_var_coordinates
293 :
294 : !___________________________________________________________________
295 0 : function element_var_coordinates3d(c,points) result(cart)
296 :
297 : type(cartesian3D_t), intent(in) :: c(4)
298 : real(r8), intent(in) :: points(:)
299 :
300 : type(cartesian3D_t) :: cart(SIZE(points),SIZE(points))
301 :
302 0 : real(r8) :: p(size(points))
303 0 : real(r8) :: q(size(points)), r
304 : integer :: i,j
305 :
306 0 : p(:) = (1.0D0-points(:))/2.0D0
307 0 : q(:) = (1.0D0+points(:))/2.0D0
308 :
309 0 : do j=1,SIZE(points)
310 0 : do i=1,SIZE(points)
311 0 : cart(i,j)%x = p(i)*p(j)*c(1)%x &
312 : + q(i)*p(j)*c(2)%x &
313 : + q(i)*q(j)*c(3)%x &
314 0 : + p(i)*q(j)*c(4)%x
315 : cart(i,j)%y = p(i)*p(j)*c(1)%y &
316 : + q(i)*p(j)*c(2)%y &
317 : + q(i)*q(j)*c(3)%y &
318 0 : + p(i)*q(j)*c(4)%y
319 : cart(i,j)%z = p(i)*p(j)*c(1)%z &
320 : + q(i)*p(j)*c(2)%z &
321 : + q(i)*q(j)*c(3)%z &
322 0 : + p(i)*q(j)*c(4)%z
323 :
324 : ! project back to sphere:
325 0 : r = distance(cart(i,j))
326 0 : cart(i,j)%x = cart(i,j)%x/r
327 0 : cart(i,j)%y = cart(i,j)%y/r
328 0 : cart(i,j)%z = cart(i,j)%z/r
329 : end do
330 : end do
331 0 : end function element_var_coordinates3d
332 :
333 : !___________________________________________________________________
334 2304 : subroutine allocate_element_desc(elem)
335 :
336 : type (element_t), intent(inout) :: elem(:)
337 : integer :: num, j,i
338 :
339 2304 : num = SIZE(elem)
340 :
341 18504 : do j=1,num
342 48600 : allocate(elem(j)%desc%putmapP(max_neigh_edges))
343 32400 : allocate(elem(j)%desc%getmapP(max_neigh_edges))
344 32400 : allocate(elem(j)%desc%putmapP_ghost(max_neigh_edges))
345 32400 : allocate(elem(j)%desc%getmapP_ghost(max_neigh_edges))
346 32400 : allocate(elem(j)%desc%putmapS(max_neigh_edges))
347 32400 : allocate(elem(j)%desc%getmapS(max_neigh_edges))
348 32400 : allocate(elem(j)%desc%reverse(max_neigh_edges))
349 32400 : allocate(elem(j)%desc%globalID(max_neigh_edges))
350 32400 : allocate(elem(j)%desc%loc2buf(max_neigh_edges))
351 148104 : do i=1,max_neigh_edges
352 129600 : elem(j)%desc%loc2buf(i)=i
353 145800 : elem(j)%desc%globalID(i)=-1
354 : enddo
355 :
356 : end do
357 2304 : end subroutine allocate_element_desc
358 :
359 :
360 0 : end module element_mod
|