FV3 Bundle
fv3jedi_geom_mod.f90
Go to the documentation of this file.
1 ! (C) Copyright 2017-2018 UCAR
2 !
3 ! This software is licensed under the terms of the Apache Licence Version 2.0
4 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
5 
6 !> Fortran module handling geometry for the FV3 model
7 
9 
10 !General JEDI uses
12 use iso_c_binding
13 use config_mod
14 use netcdf
15 
16 !FMS/MPP uses
18 use mpp_domains_mod, only: mpp_define_layout, mpp_define_mosaic, mpp_define_io_domain
19 use mpp_mod, only: mpp_pe, mpp_npes, mpp_error, fatal, note
20 
21 !Uses for generating geometry using FV3 routines
24 
25 implicit none
26 private
27 
28 public :: fv3jedi_geom
29 public :: create, clone, delete, info
30 
31 ! ------------------------------------------------------------------------------
32 
33 !> Fortran derived type to hold geometry data for the FV3JEDI model
34 type :: fv3jedi_geom
35  integer :: isd, ied, jsd, jed !data domain
36  integer :: isc, iec, jsc, jec !compute domain
37  integer :: npx,npy,npz !x/y/z-dir grid edge points per tile
38  integer :: layout(2) !Processor layout for computation
39  integer :: io_layout(2) !Processor layout for read/write
40  integer :: halo !Number of halo points, normally 3
41  character(len=255) :: nml_file !FV3 nml file associated with this geom
42  integer :: size_cubic_grid !Size of cubed sphere grid (cell center)
43  type(domain2d) :: domain !MPP domain
44  integer :: ntile !Tile ID
45  integer :: ntiles = 6 !Number of tiles, always 6
46  integer :: stackmax !Stackmax
47  real(kind=kind_real), allocatable :: grid_lon(:,:) !Longitude at cell center
48  real(kind=kind_real), allocatable :: grid_lat(:,:) !Latitude at cell center
49  real(kind=kind_real), allocatable :: egrid_lon(:,:) !Longitude at cell center
50  real(kind=kind_real), allocatable :: egrid_lat(:,:) !Latitude at cell center
51  real(kind=kind_real), allocatable :: area(:,:) !Grid area
52  real(kind=kind_real), allocatable :: ak(:),bk(:) !Model level coefficients
53  real(kind=kind_real) :: ptop !Pressure at top of domain
54  real(kind=kind_real), allocatable :: sin_sg(:,:,:)
55  real(kind=kind_real), allocatable :: cos_sg(:,:,:)
56  real(kind=kind_real), allocatable :: cosa_u(:,:)
57  real(kind=kind_real), allocatable :: cosa_v(:,:)
58  real(kind=kind_real), allocatable :: cosa_s(:,:)
59  real(kind=kind_real), allocatable :: rsin_u(:,:)
60  real(kind=kind_real), allocatable :: rsin_v(:,:)
61  real(kind=kind_real), allocatable :: rsin2(:,:)
62  real(kind=kind_real), allocatable :: dxa(:,:)
63  real(kind=kind_real), allocatable :: dya(:,:)
64  real(kind=kind_real), allocatable :: dx(:,:)
65  real(kind=kind_real), allocatable :: dy(:,:)
66  real(kind=kind_real), allocatable :: dxc(:,:)
67  real(kind=kind_real), allocatable :: dyc(:,:)
68  real(kind=kind_real), allocatable :: rarea(:,:)
69  real(kind=kind_real), allocatable :: rarea_c(:,:)
70  real(kind=kind_real), allocatable :: edge_w(:)
71  real(kind=kind_real), allocatable :: edge_e(:)
72  real(kind=kind_real), allocatable :: edge_s(:)
73  real(kind=kind_real), allocatable :: edge_n(:)
74  real(kind=kind_real), allocatable :: grid(:,:,:)
75  real(kind=kind_real), allocatable :: agrid(:,:,:)
76  logical :: sw_corner, se_corner, ne_corner, nw_corner
77  real(kind=kind_real), allocatable :: vlon(:,:,:)
78  real(kind=kind_real), allocatable :: vlat(:,:,:)
79  real(kind=kind_real), allocatable :: edge_vect_n(:)
80  real(kind=kind_real), allocatable :: edge_vect_e(:)
81  real(kind=kind_real), allocatable :: edge_vect_s(:)
82  real(kind=kind_real), allocatable :: edge_vect_w(:)
83  real(kind=kind_real), allocatable :: es(:,:,:,:)
84  real(kind=kind_real), allocatable :: ew(:,:,:,:)
85  real(kind=kind_real), allocatable :: a11(:,:)
86  real(kind=kind_real), allocatable :: a12(:,:)
87  real(kind=kind_real), allocatable :: a21(:,:)
88  real(kind=kind_real), allocatable :: a22(:,:)
89 end type fv3jedi_geom
90 
91 ! ------------------------------------------------------------------------------
92 
93 contains
94 
95 ! ------------------------------------------------------------------------------
96 
97 subroutine create(self, c_conf)
98 
99 implicit none
100 
101 !Arguments
102 type(fv3jedi_geom), intent(inout) :: self
103 type(c_ptr), intent(in) :: c_conf
104 
105 !Locals
106 character(len=256) :: filename_akbk
107 character(len=256) :: filepath_akbk
108 character(len=256) :: ak_var
109 character(len=256) :: bk_var
110 type(fv_atmos_type), allocatable :: fv_atm(:)
111 logical, allocatable :: grids_on_this_pe(:)
112 integer :: p_split = 1
113 integer :: ncstat, ncid, varid, i, readdim, dcount
114 integer, dimension(nf90_max_var_dims) :: dimids, dimlens
115 
116 ! User input constructing the grid
117 ! --------------------------------
118 self%nml_file = config_get_string(c_conf,len(self%nml_file),"nml_file")
119 
120 !Halo
121 self%halo = config_get_int(c_conf,"halo")
122 
123 
124 ! Set filenames for ak and bk
125 ! ---------------------------
126 filepath_akbk = "Data/"
127 filename_akbk = 'grid_spec.nc'
128 
129 if (config_element_exists(c_conf,"filepath_akbk")) then
130  filepath_akbk = config_get_string(c_conf,len(filepath_akbk),"filepath_akbk")
131 endif
132 
133 if (config_element_exists(c_conf,"filename_akbk")) then
134  filename_akbk = config_get_string(c_conf,len(filename_akbk),"filename_akbk")
135 endif
136 
137 filename_akbk = trim(filepath_akbk)//"/"//trim(filename_akbk)
138 
139 ak_var = "AK"
140 bk_var = "BK"
141 if (config_element_exists(c_conf,"ak_var")) then
142  ak_var = config_get_string(c_conf,len(ak_var),"ak_var")
143 endif
144 if (config_element_exists(c_conf,"bk_var")) then
145  bk_var = config_get_string(c_conf,len(bk_var),"bk_var")
146 endif
147 
148 !Intialize using the model setup routine
149 call fv_init(fv_atm, 300.0_kind_real, grids_on_this_pe, p_split)
150 deallocate(pelist_all)
151 
152 self%isd = fv_atm(1)%bd%isd
153 self%ied = fv_atm(1)%bd%ied
154 self%jsd = fv_atm(1)%bd%jsd
155 self%jed = fv_atm(1)%bd%jed
156 self%isc = fv_atm(1)%bd%isc
157 self%iec = fv_atm(1)%bd%iec
158 self%jsc = fv_atm(1)%bd%jsc
159 self%jec = fv_atm(1)%bd%jec
160 self%ntile = fv_atm(1)%tile
161 
162 self%npx = fv_atm(1)%npx
163 self%npy = fv_atm(1)%npy
164 self%npz = fv_atm(1)%npz
165 self%layout(1) = fv_atm(1)%layout(1)
166 self%layout(2) = fv_atm(1)%layout(2)
167 self%io_layout(1) = fv_atm(1)%io_layout(1)
168 self%io_layout(2) = fv_atm(1)%io_layout(2)
169 
170 !Lat,lon and area from
171 allocate ( self%area(self%isd:self%ied, self%jsd:self%jed) )
172 allocate ( self%grid_lon(self%isd:self%ied, self%jsd:self%jed) )
173 allocate ( self%grid_lat(self%isd:self%ied, self%jsd:self%jed) )
174 allocate ( self%egrid_lon(self%isd:self%ied+1, self%jsd:self%jed+1) )
175 allocate ( self%egrid_lat(self%isd:self%ied+1, self%jsd:self%jed+1) )
176 
177 self%area = fv_atm(1)%gridstruct%area_64
178 self%grid_lon = real(FV_Atm(1)%gridstruct%agrid_64(:,:,1),kind_real)
179 self%grid_lat = real(FV_Atm(1)%gridstruct%agrid_64(:,:,2),kind_real)
180 self%egrid_lon = real(FV_Atm(1)%gridstruct%grid_64(:,:,1),kind_real)
181 self%egrid_lat = real(FV_Atm(1)%gridstruct%grid_64(:,:,2),kind_real)
182 
183 allocate( self%sin_sg(self%isd:self%ied ,self%jsd:self%jed ,9))
184 allocate( self%cos_sg(self%isd:self%ied ,self%jsd:self%jed ,9))
185 allocate( self%cosa_u(self%isd:self%ied+1,self%jsd:self%jed ))
186 allocate( self%cosa_v(self%isd:self%ied ,self%jsd:self%jed+1))
187 allocate( self%cosa_s(self%isd:self%ied ,self%jsd:self%jed ))
188 allocate( self%rsin_u(self%isd:self%ied+1,self%jsd:self%jed ))
189 allocate( self%rsin_v(self%isd:self%ied ,self%jsd:self%jed+1))
190 allocate( self%rsin2(self%isd:self%ied ,self%jsd:self%jed ))
191 allocate( self%dxa(self%isd:self%ied ,self%jsd:self%jed ))
192 allocate( self%dya(self%isd:self%ied ,self%jsd:self%jed ))
193 allocate( self%dx(self%isd:self%ied ,self%jsd:self%jed+1))
194 allocate( self%dy(self%isd:self%ied+1,self%jsd:self%jed ))
195 allocate( self%dxc(self%isd:self%ied+1,self%jsd:self%jed ))
196 allocate( self%dyc(self%isd:self%ied ,self%jsd:self%jed+1))
197 allocate( self%rarea(self%isd:self%ied ,self%jsd:self%jed ))
198 allocate(self%rarea_c(self%isd:self%ied+1,self%jsd:self%jed+1))
199 allocate(self%edge_s(self%npx))
200 allocate(self%edge_n(self%npx))
201 allocate(self%edge_w(self%npy))
202 allocate(self%edge_e(self%npy))
203 allocate(self%grid (self%isd:self%ied+1,self%jsd:self%jed+1,1:2))
204 allocate(self%agrid(self%isd:self%ied ,self%jsd:self%jed ,1:2))
205 allocate(self%vlon(self%isc-2:self%iec+2,self%jsc-2:self%jec+2,3))
206 allocate(self%vlat(self%isc-2:self%iec+2,self%jsc-2:self%jec+2,3))
207 allocate(self%edge_vect_n(self%isd:self%ied))
208 allocate(self%edge_vect_e(self%jsd:self%jed))
209 allocate(self%edge_vect_s(self%isd:self%ied))
210 allocate(self%edge_vect_w(self%jsd:self%jed))
211 allocate(self%es(3,self%isd:self%ied ,self%jsd:self%jed+1,2))
212 allocate(self%ew(3,self%isd:self%ied+1,self%jsd:self%jed, 2))
213 allocate(self%a11(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
214 allocate(self%a12(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
215 allocate(self%a21(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
216 allocate(self%a22(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
217 
218 self%sin_sg = fv_atm(1)%gridstruct%sin_sg
219 self%cos_sg = fv_atm(1)%gridstruct%cos_sg
220 self%cosa_u = fv_atm(1)%gridstruct%cosa_u
221 self%cosa_v = fv_atm(1)%gridstruct%cosa_v
222 self%cosa_s = fv_atm(1)%gridstruct%cosa_s
223 self%rsin_u = fv_atm(1)%gridstruct%rsin_u
224 self%rsin_v = fv_atm(1)%gridstruct%rsin_v
225 self%rsin2 = fv_atm(1)%gridstruct%rsin2
226 self%dxa = fv_atm(1)%gridstruct%dxa
227 self%dya = fv_atm(1)%gridstruct%dya
228 self%dx = fv_atm(1)%gridstruct%dx
229 self%dy = fv_atm(1)%gridstruct%dy
230 self%dxc = fv_atm(1)%gridstruct%dxc
231 self%dyc = fv_atm(1)%gridstruct%dyc
232 self%rarea = fv_atm(1)%gridstruct%rarea
233 self%rarea_c = fv_atm(1)%gridstruct%rarea_c
234 self%sw_corner = fv_atm(1)%gridstruct%sw_corner
235 self%se_corner = fv_atm(1)%gridstruct%se_corner
236 self%ne_corner = fv_atm(1)%gridstruct%ne_corner
237 self%nw_corner = fv_atm(1)%gridstruct%nw_corner
238 self%edge_s = fv_atm(1)%gridstruct%edge_s
239 self%edge_n = fv_atm(1)%gridstruct%edge_n
240 self%edge_w = fv_atm(1)%gridstruct%edge_w
241 self%edge_e = fv_atm(1)%gridstruct%edge_e
242 self%grid = fv_atm(1)%gridstruct%grid
243 self%agrid = fv_atm(1)%gridstruct%agrid
244 self%vlon = fv_atm(1)%gridstruct%vlon
245 self%vlat = fv_atm(1)%gridstruct%vlat
246 self%edge_vect_n = fv_atm(1)%gridstruct%edge_vect_n
247 self%edge_vect_e = fv_atm(1)%gridstruct%edge_vect_e
248 self%edge_vect_s = fv_atm(1)%gridstruct%edge_vect_s
249 self%edge_vect_w = fv_atm(1)%gridstruct%edge_vect_w
250 self%es = fv_atm(1)%gridstruct%es
251 self%ew = fv_atm(1)%gridstruct%ew
252 self%a11 = fv_atm(1)%gridstruct%a11
253 self%a12 = fv_atm(1)%gridstruct%a12
254 self%a21 = fv_atm(1)%gridstruct%a21
255 self%a22 = fv_atm(1)%gridstruct%a22
256 
257 !ak and bk are read from file
258 allocate ( self%ak(self%npz+1) )
259 allocate ( self%bk(self%npz+1) )
260 
261 ncstat = nf90_open(filename_akbk, nf90_nowrite, ncid)
262 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
263 
264 ncstat = nf90_inq_varid(ncid, ak_var, varid)
265 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
266 
267 dimids = 0
268 ncstat = nf90_inquire_variable(ncid, varid, dimids = dimids)
269 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
270 
271 readdim = -1
272 dcount = 0
273 do i = 1,nf90_max_var_dims
274  if (dimids(i) > 0) then
275  ncstat = nf90_inquire_dimension(ncid, dimids(i), len = dimlens(i))
276  if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
277  if (dimlens(i) == self%npz+1) then
278  readdim = i
279  endif
280  dcount = dcount + 1
281  endif
282 enddo
283 
284 if (readdim == -1) call abor1_ftn("fv3-jedi geometry: ak/bk in file does not match dimension of npz from input.nml")
285 
286 ncstat = nf90_get_var(ncid, varid, self%ak)
287 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
288 
289 ncstat = nf90_inq_varid(ncid, bk_var, varid)
290 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
291 ncstat = nf90_get_var(ncid, varid, self%bk)
292 if(ncstat /= nf90_noerr) print *, trim(nf90_strerror(ncstat))
293 
294 self%ptop = self%ak(1)
295 
296 !Done with the FV_Atm stucture here
297 call deallocate_fv_atmos_type(fv_atm(1))
298 deallocate(fv_atm)
299 deallocate(grids_on_this_pe)
300 
301 !Misc
302 self%stackmax = 4000000
303 self%size_cubic_grid = self%npx-1
304 
305 !Resetup domain to avoid risk of copied pointers
306 call setup_domain( self%domain, self%size_cubic_grid, self%size_cubic_grid, &
307  self%ntiles, self%layout, self%io_layout, self%halo)
308 
309 end subroutine create
310 
311 ! ------------------------------------------------------------------------------
312 
313 subroutine clone(self, other)
315 implicit none
316 
317 type(fv3jedi_geom), intent(in ) :: self
318 type(fv3jedi_geom), intent(inout) :: other
319 
320 allocate(other%grid_lon(self%isd:self%ied, self%jsd:self%jed))
321 allocate(other%grid_lat(self%isd:self%ied, self%jsd:self%jed))
322 allocate(other%egrid_lon(self%isd:self%ied+1, self%jsd:self%jed+1) )
323 allocate(other%egrid_lat(self%isd:self%ied+1, self%jsd:self%jed+1) )
324 allocate(other%area(self%isd:self%ied, self%jsd:self%jed))
325 allocate(other%ak(self%npz+1))
326 allocate(other%bk(self%npz+1))
327 
328 allocate( other%sin_sg(self%isd:self%ied ,self%jsd:self%jed ,9))
329 allocate( other%cos_sg(self%isd:self%ied ,self%jsd:self%jed ,9))
330 allocate( other%cosa_u(self%isd:self%ied+1,self%jsd:self%jed ))
331 allocate( other%cosa_v(self%isd:self%ied ,self%jsd:self%jed+1))
332 allocate( other%cosa_s(self%isd:self%ied ,self%jsd:self%jed ))
333 allocate( other%rsin_u(self%isd:self%ied+1,self%jsd:self%jed ))
334 allocate( other%rsin_v(self%isd:self%ied ,self%jsd:self%jed+1))
335 allocate( other%rsin2(self%isd:self%ied ,self%jsd:self%jed ))
336 allocate( other%dxa(self%isd:self%ied ,self%jsd:self%jed ))
337 allocate( other%dya(self%isd:self%ied ,self%jsd:self%jed ))
338 allocate( other%dx(self%isd:self%ied ,self%jsd:self%jed+1))
339 allocate( other%dy(self%isd:self%ied+1,self%jsd:self%jed ))
340 allocate( other%dxc(self%isd:self%ied+1,self%jsd:self%jed ))
341 allocate( other%dyc(self%isd:self%ied ,self%jsd:self%jed+1))
342 allocate( other%rarea(self%isd:self%ied ,self%jsd:self%jed ))
343 allocate(other%rarea_c(self%isd:self%ied ,self%jsd:self%jed ))
344 allocate(other%edge_s(self%npx))
345 allocate(other%edge_n(self%npx))
346 allocate(other%edge_w(self%npy))
347 allocate(other%edge_e(self%npy))
348 allocate(other%grid (self%isd:self%ied+1,self%jsd:self%jed+1,1:2))
349 allocate(other%agrid(self%isd:self%ied ,self%jsd:self%jed ,1:2))
350 allocate(other%vlon(self%isc-2:self%iec+2,self%jsc-2:self%jec+2,3))
351 allocate(other%vlat(self%isc-2:self%iec+2,self%jsc-2:self%jec+2,3))
352 allocate(other%edge_vect_n(self%isd:self%ied))
353 allocate(other%edge_vect_e(self%jsd:self%jed))
354 allocate(other%edge_vect_s(self%isd:self%ied))
355 allocate(other%edge_vect_w(self%jsd:self%jed))
356 allocate(other%es(3,self%isd:self%ied ,self%jsd:self%jed+1,2))
357 allocate(other%ew(3,self%isd:self%ied+1,self%jsd:self%jed, 2))
358 allocate(other%a11(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
359 allocate(other%a12(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
360 allocate(other%a21(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
361 allocate(other%a22(self%isc-1:self%iec+1,self%jsc-1:self%jec+1) )
362 
363 other%npx = self%npx
364 other%npy = self%npy
365 other%npz = self%npz
366 other%layout = self%layout
367 other%io_layout = self%io_layout
368 other%halo = self%halo
369 other%nml_file = self%nml_file
370 other%size_cubic_grid = self%size_cubic_grid
371 other%isc = self%isc
372 other%isd = self%isd
373 other%iec = self%iec
374 other%ied = self%ied
375 other%jsc = self%jsc
376 other%jsd = self%jsd
377 other%jec = self%jec
378 other%jed = self%jed
379 other%ntile = self%ntile
380 other%ntiles = self%ntiles
381 other%stackmax = self%stackmax
382 other%grid_lon = self%grid_lon
383 other%grid_lat = self%grid_lat
384 other%egrid_lon = self%egrid_lon
385 other%egrid_lat = self%egrid_lat
386 other%area = self%area
387 other%ak = self%ak
388 other%bk = self%bk
389 other%ptop = self%ptop
390 
391 other%sin_sg = self%sin_sg
392 other%cos_sg = self%cos_sg
393 other%cosa_u = self%cosa_u
394 other%cosa_v = self%cosa_v
395 other%cosa_s = self%cosa_s
396 other%rsin_u = self%rsin_u
397 other%rsin_v = self%rsin_v
398 other%rsin2 = self%rsin2
399 other%dxa = self%dxa
400 other%dya = self%dya
401 other%dx = self%dx
402 other%dy = self%dy
403 other%dxc = self%dxc
404 other%dyc = self%dyc
405 other%rarea = self%rarea
406 other%rarea_c = self%rarea_c
407 other%sw_corner = self%sw_corner
408 other%se_corner = self%se_corner
409 other%ne_corner = self%ne_corner
410 other%nw_corner = self%nw_corner
411 other%edge_s = self%edge_s
412 other%edge_n = self%edge_n
413 other%edge_w = self%edge_w
414 other%edge_e = self%edge_e
415 other%grid = self%grid
416 other%agrid = self%agrid
417 other%vlon = self%vlon
418 other%vlat = self%vlat
419 other%edge_vect_n = self%edge_vect_n
420 other%edge_vect_e = self%edge_vect_e
421 other%edge_vect_s = self%edge_vect_s
422 other%edge_vect_w = self%edge_vect_w
423 other%es = self%es
424 other%ew = self%ew
425 other%a11 = self%a11
426 other%a12 = self%a12
427 other%a21 = self%a21
428 other%a22 = self%a22
429 
430 call setup_domain( other%domain, other%size_cubic_grid, other%size_cubic_grid, &
431  other%ntiles, other%layout, other%io_layout, other%halo)
432 
433 end subroutine clone
434 
435 ! ------------------------------------------------------------------------------
436 
437 subroutine delete(self)
439 implicit none
440 
441 type(fv3jedi_geom), intent(inout) :: self
442 
443 ! Deallocate
444 deallocate(self%grid_lon)
445 deallocate(self%grid_lat)
446 deallocate(self%egrid_lon)
447 deallocate(self%egrid_lat)
448 deallocate(self%area)
449 deallocate(self%ak)
450 deallocate(self%bk)
451 
452 deallocate(self%sin_sg)
453 deallocate(self%cos_sg)
454 deallocate(self%cosa_u)
455 deallocate(self%cosa_v)
456 deallocate(self%cosa_s)
457 deallocate(self%rsin_u)
458 deallocate(self%rsin_v)
459 deallocate( self%rsin2)
460 deallocate( self%dxa)
461 deallocate( self%dya)
462 deallocate( self%dx)
463 deallocate( self%dy)
464 deallocate( self%dxc)
465 deallocate( self%dyc)
466 deallocate( self%rarea)
467 deallocate( self%rarea_c)
468 deallocate(self%edge_s)
469 deallocate(self%edge_n)
470 deallocate(self%edge_w)
471 deallocate(self%edge_e)
472 deallocate(self%grid)
473 deallocate(self%agrid)
474 deallocate(self%vlon)
475 deallocate(self%vlat)
476 deallocate(self%edge_vect_n)
477 deallocate(self%edge_vect_e)
478 deallocate(self%edge_vect_s)
479 deallocate(self%edge_vect_w)
480 deallocate(self%es)
481 deallocate(self%ew)
482 deallocate(self%a11)
483 deallocate(self%a12)
484 deallocate(self%a21)
485 deallocate(self%a22)
486 
487 call mpp_deallocate_domain(self%domain)
488 
489 end subroutine delete
490 
491 ! ------------------------------------------------------------------------------
492 
493 subroutine info(self)
495 implicit none
496 
497 type(fv3jedi_geom), intent(in) :: self
498 
499 end subroutine info
500 
501 ! ------------------------------------------------------------------------------
502 
503 subroutine setup_domain(domain, nx, ny, ntiles, layout_in, io_layout, halo)
505  implicit none
506 
507  type(domain2D), intent(inout) :: domain
508  integer, intent(in) :: nx, ny, ntiles
509  integer, intent(in) :: layout_in(:), io_layout(:)
510  integer, intent(in) :: halo
511 
512  integer :: pe, npes, npes_per_tile, tile
513  integer :: num_contact
514  integer :: n, layout(2)
515  integer, allocatable, dimension(:,:) :: global_indices, layout2D
516  integer, allocatable, dimension(:) :: pe_start, pe_end
517  integer, allocatable, dimension(:) :: tile1, tile2
518  integer, allocatable, dimension(:) :: istart1, iend1, jstart1, jend1
519  integer, allocatable, dimension(:) :: istart2, iend2, jstart2, jend2
520  integer, allocatable :: tile_id(:)
521  logical :: is_symmetry
522 
523  pe = mpp_pe()
524  npes = mpp_npes()
525 
526  if (mod(npes,ntiles) /= 0) then
527  call mpp_error(note, "setup_domain: npes can not be divided by ntiles")
528  return
529  endif
530  npes_per_tile = npes/ntiles
531  tile = pe/npes_per_tile + 1
532 
533  if (layout_in(1)*layout_in(2) == npes_per_tile) then
534  layout = layout_in
535  else
536  call mpp_define_layout( (/1,nx,1,ny/), npes_per_tile, layout )
537  endif
538 
539  if (io_layout(1) <1 .or. io_layout(2) <1) call mpp_error(fatal, &
540  "setup_domain: both elements of variable io_layout must be positive integer")
541  if (mod(layout(1), io_layout(1)) /= 0 ) call mpp_error(fatal, &
542  "setup_domain: layout(1) must be divided by io_layout(1)")
543  if (mod(layout(2), io_layout(2)) /= 0 ) call mpp_error(fatal, &
544  "setup_domain: layout(2) must be divided by io_layout(2)")
545 
546  allocate(global_indices(4,ntiles), layout2d(2,ntiles), pe_start(ntiles), pe_end(ntiles) )
547  do n = 1, ntiles
548  global_indices(:,n) = (/1,nx,1,ny/)
549  layout2d(:,n) = layout
550  pe_start(n) = (n-1)*npes_per_tile
551  pe_end(n) = n*npes_per_tile-1
552  enddo
553 
554  ! this code copied from domain_decomp in fv_mp_mod.f90
555  num_contact = 12
556  allocate(tile1(num_contact), tile2(num_contact) )
557  allocate(tile_id(ntiles))
558  allocate(istart1(num_contact), iend1(num_contact), jstart1(num_contact), jend1(num_contact) )
559  allocate(istart2(num_contact), iend2(num_contact), jstart2(num_contact), jend2(num_contact) )
560  !--- Contact line 1, between tile 1 (EAST) and tile 2 (WEST)
561  tile1(1) = 1; tile2(1) = 2
562  istart1(1) = nx; iend1(1) = nx; jstart1(1) = 1; jend1(1) = ny
563  istart2(1) = 1; iend2(1) = 1; jstart2(1) = 1; jend2(1) = ny
564  !--- Contact line 2, between tile 1 (NORTH) and tile 3 (WEST)
565  tile1(2) = 1; tile2(2) = 3
566  istart1(2) = 1; iend1(2) = nx; jstart1(2) = ny; jend1(2) = ny
567  istart2(2) = 1; iend2(2) = 1; jstart2(2) = ny; jend2(2) = 1
568  !--- Contact line 3, between tile 1 (WEST) and tile 5 (NORTH)
569  tile1(3) = 1; tile2(3) = 5
570  istart1(3) = 1; iend1(3) = 1; jstart1(3) = 1; jend1(3) = ny
571  istart2(3) = nx; iend2(3) = 1; jstart2(3) = ny; jend2(3) = ny
572  !--- Contact line 4, between tile 1 (SOUTH) and tile 6 (NORTH)
573  tile1(4) = 1; tile2(4) = 6
574  istart1(4) = 1; iend1(4) = nx; jstart1(4) = 1; jend1(4) = 1
575  istart2(4) = 1; iend2(4) = nx; jstart2(4) = ny; jend2(4) = ny
576  !--- Contact line 5, between tile 2 (NORTH) and tile 3 (SOUTH)
577  tile1(5) = 2; tile2(5) = 3
578  istart1(5) = 1; iend1(5) = nx; jstart1(5) = ny; jend1(5) = ny
579  istart2(5) = 1; iend2(5) = nx; jstart2(5) = 1; jend2(5) = 1
580  !--- Contact line 6, between tile 2 (EAST) and tile 4 (SOUTH)
581  tile1(6) = 2; tile2(6) = 4
582  istart1(6) = nx; iend1(6) = nx; jstart1(6) = 1; jend1(6) = ny
583  istart2(6) = nx; iend2(6) = 1; jstart2(6) = 1; jend2(6) = 1
584  !--- Contact line 7, between tile 2 (SOUTH) and tile 6 (EAST)
585  tile1(7) = 2; tile2(7) = 6
586  istart1(7) = 1; iend1(7) = nx; jstart1(7) = 1; jend1(7) = 1
587  istart2(7) = nx; iend2(7) = nx; jstart2(7) = ny; jend2(7) = 1
588  !--- Contact line 8, between tile 3 (EAST) and tile 4 (WEST)
589  tile1(8) = 3; tile2(8) = 4
590  istart1(8) = nx; iend1(8) = nx; jstart1(8) = 1; jend1(8) = ny
591  istart2(8) = 1; iend2(8) = 1; jstart2(8) = 1; jend2(8) = ny
592  !--- Contact line 9, between tile 3 (NORTH) and tile 5 (WEST)
593  tile1(9) = 3; tile2(9) = 5
594  istart1(9) = 1; iend1(9) = nx; jstart1(9) = ny; jend1(9) = ny
595  istart2(9) = 1; iend2(9) = 1; jstart2(9) = ny; jend2(9) = 1
596  !--- Contact line 10, between tile 4 (NORTH) and tile 5 (SOUTH)
597  tile1(10) = 4; tile2(10) = 5
598  istart1(10) = 1; iend1(10) = nx; jstart1(10) = ny; jend1(10) = ny
599  istart2(10) = 1; iend2(10) = nx; jstart2(10) = 1; jend2(10) = 1
600  !--- Contact line 11, between tile 4 (EAST) and tile 6 (SOUTH)
601  tile1(11) = 4; tile2(11) = 6
602  istart1(11) = nx; iend1(11) = nx; jstart1(11) = 1; jend1(11) = ny
603  istart2(11) = nx; iend2(11) = 1; jstart2(11) = 1; jend2(11) = 1
604  !--- Contact line 12, between tile 5 (EAST) and tile 6 (WEST)
605  tile1(12) = 5; tile2(12) = 6
606  istart1(12) = nx; iend1(12) = nx; jstart1(12) = 1; jend1(12) = ny
607  istart2(12) = 1; iend2(12) = 1; jstart2(12) = 1; jend2(12) = ny
608  is_symmetry = .true.
609  do n = 1, ntiles
610  tile_id(n) = n
611  enddo
612 
613  call mpp_define_mosaic(global_indices, layout2d, domain, ntiles, num_contact, tile1, tile2, &
614  istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, &
615  pe_start, pe_end, whalo=halo, ehalo=halo, shalo=halo, nhalo=halo, &
616  symmetry=is_symmetry, tile_id=tile_id, &
617  name='cubic_grid')
618 
619  if (io_layout(1) /= 1 .or. io_layout(2) /= 1) call mpp_define_io_domain(domain, io_layout)
620 
621  deallocate(pe_start, pe_end)
622  deallocate(layout2d, global_indices)
623  deallocate(tile1, tile2, tile_id)
624  deallocate(istart1, iend1, jstart1, jend1)
625  deallocate(istart2, iend2, jstart2, jend2)
626 
627 end subroutine setup_domain
628 
629 ! ------------------------------------------------------------------------------
630 
631 end module fv3jedi_geom_mod
subroutine, public delete(self)
integer, dimension(:), allocatable, public pelist_all
subroutine, public create(self, c_conf)
Fortran derived type to hold geometry data for the FV3JEDI model.
Definition: mpp.F90:39
subroutine, public fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)
subroutine, public info(self)
subroutine setup_domain(domain, nx, ny, ntiles, layout_in, io_layout, halo)
Fortran module handling geometry for the FV3 model.
subroutine deallocate_fv_atmos_type(Atm)
integer, parameter, public kind_real
subroutine, public clone(self, other)