Skip to content

Commit 32ed6b9

Browse files
tclunetclune
authored
Merge pull request #8 from GEOS-ESM/bugfix/yvikhlya/tripolar_grid_fix
This fixes a bug which caused a crash when creating MOM grid in coupl…
2 parents 07de57d + 7623b78 commit 32ed6b9

File tree

2 files changed

+142
-113
lines changed

2 files changed

+142
-113
lines changed

‎MAPL_Base/MAPL_GridManager.F90

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,7 @@ end subroutine add_prototype
8484

8585
function make_clone(this, grid_type, unusable, rc) result(factory)
8686
use MAPL_LatLonGridFactoryMod, only: LatLonGridFactory
87+
use MAPL_TripolarGridFactoryMod, only: TripolarGridFactory
8788
class (AbstractGridFactory), allocatable :: factory
8889
class (GridManager), intent(inout) :: this
8990
character(len=*), intent(in) :: grid_type
@@ -102,11 +103,13 @@ function make_clone(this, grid_type, unusable, rc) result(factory)
102103
!---------------
103104
logical, save :: initialized = .false.
104105
type (LatLonGridFactory) :: latlon_factory
106+
type (TripolarGridFactory) :: tripolar_factory
105107

106108
_UNUSED_DUMMY(unusable)
107109

108110
if (.not. initialized) then
109111
call this%prototypes%insert('LatLon', latlon_factory)
112+
call this%prototypes%insert('Tripolar',tripolar_factory)
110113
initialized = .true.
111114
end if
112115

‎MAPL_Base/MAPL_TripolarGridFactory.F90

Lines changed: 139 additions & 113 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ module MAPL_TripolarGridFactoryMod
3131
character(len=*), parameter :: UNDEFINED_CHAR = '**'
3232

3333
character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN'
34+
character(len=*), parameter :: GRID_FILE_NAME_DEFAULT = 'UNKNOWN'
3435

3536
type, extends(AbstractGridFactory) :: TripolarGridFactory
3637
private
@@ -63,7 +64,6 @@ module MAPL_TripolarGridFactoryMod
6364
procedure :: equals
6465

6566
procedure :: read_grid_dimensions
66-
procedure :: read_grid_coordinates
6767
procedure :: check_and_fill_consistency
6868
procedure :: generate_grid_name
6969
procedure :: to_string
@@ -85,13 +85,16 @@ module MAPL_TripolarGridFactoryMod
8585

8686

8787
function TripolarGridFactory_from_parameters(unusable, grid_file_name, grid_name, &
88-
& nx, ny, rc) result(factory)
88+
& im_world,jm_world,lm,nx, ny, rc) result(factory)
8989
type (TripolarGridFactory) :: factory
9090
class (KeywordEnforcer), optional, intent(in) :: unusable
9191

9292
! grid details:
9393
character(len=*), intent(in) :: grid_file_name ! required
9494
character(len=*), optional, intent(in) :: grid_name
95+
integer, optional, intent(in) :: im_world
96+
integer, optional, intent(in) :: jm_world
97+
integer, optional, intent(in) :: lm
9598

9699
! decomposition:
97100
integer, optional, intent(in) :: nx
@@ -100,20 +103,17 @@ function TripolarGridFactory_from_parameters(unusable, grid_file_name, grid_name
100103

101104
integer :: status
102105
character(len=*), parameter :: Iam = MOD_NAME // 'TripolarGridFactory_from_parameters'
103-
logical :: exists
104106

105107
if (present(unusable)) print*,shape(unusable)
106108

107109
call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT)
110+
call set_with_default(factory%grid_file_name, grid_file_name, GRID_FILE_NAME_DEFAULT)
108111

109112
call set_with_default(factory%ny, nx, UNDEFINED_INTEGER)
110113
call set_with_default(factory%nx, ny, UNDEFINED_INTEGER)
111-
112-
factory%grid_file_name = grid_file_name
113-
inquire(file=grid_file_name, exist=exists)
114-
_ASSERT(exists)
115-
116-
call factory%read_grid_dimensions()
114+
call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER)
115+
call set_with_default(factory%jm_world, jm_world, UNDEFINED_INTEGER)
116+
call set_with_default(factory%lm, lm, UNDEFINED_INTEGER)
117117

118118
call factory%check_and_fill_consistency(rc=status)
119119
_VERIFY(status)
@@ -157,19 +157,20 @@ function create_basic_grid(this, unusable, rc) result(grid)
157157

158158
_UNUSED_DUMMY(unusable)
159159

160-
grid = ESMF_GridCreate( &
161-
& name = this%grid_name, &
162-
& countsPerDEDim1=this%ims, &
163-
& countsPerDEDim2=this%jms, &
164-
& indexFlag=ESMF_INDEX_DELOCAL, &
165-
& gridEdgeLWidth=[0,0], &
166-
& gridEdgeUWidth=[0,0], &
167-
& coordDep1=[1,2], &
168-
& coordDep2=[1,2], &
169-
& rc=status)
160+
grid = ESMF_GridCreate1PeriDim( &
161+
name=trim(this%grid_name) ,&
162+
countsPerDEDim1=this%ims, &
163+
countsPerDEDim2=this%jms, &
164+
indexFlag=ESMF_INDEX_DELOCAL, &
165+
gridEdgeLWidth=[0,0], &
166+
gridEdgeUWidth=[0,1], &
167+
coordDep1=[1,2], &
168+
coordDep2=[1,2], &
169+
poleKindFlag=[ESMF_POLEKIND_MONOPOLE,ESMF_POLEKIND_BIPOLE], &
170+
coordSys=ESMF_COORDSYS_SPH_RAD, rc=status)
170171
_VERIFY(status)
171172

172-
! Allocate coords at default stagger location
173+
!Allocate coords at default stagger location
173174
call ESMF_GridAddCoord(grid, rc=status)
174175
_VERIFY(status)
175176

@@ -185,44 +186,87 @@ function create_basic_grid(this, unusable, rc) result(grid)
185186
end function create_basic_grid
186187

187188
subroutine add_horz_coordinates(this, grid, unusable, rc)
188-
use MAPL_BaseMod, only: MAPL_grid_interior
189+
use MAPL_BaseMod, only: MAPL_grid_interior, MAPL_gridget
189190
use MAPL_CommsMod
191+
use MAPL_IOMod
192+
use MAPL_ConstantsMod
190193
class (TripolarGridFactory), intent(in) :: this
191194
type (ESMF_Grid), intent(inout) :: grid
192195
class (KeywordEnforcer), optional, intent(in) :: unusable
193196
integer, optional, intent(out) :: rc
194197

195-
integer :: i_1, i_n, j_1, j_n ! regional array bounds
196-
real(kind=ESMF_KIND_R8), pointer :: centers(:,:)
197-
real(kind=ESMF_KIND_R8), allocatable :: longitudes(:,:)
198-
real(kind=ESMF_KIND_R8), allocatable :: latitudes(:,:)
199198
integer :: status
200199
character(len=*), parameter :: Iam = MOD_NAME // 'add_horz_coordinates'
200+
201+
integer :: UNIT
202+
integer :: IM, JM
203+
integer :: IMSTART, JMSTART
204+
integer :: IM_WORLD, JM_WORLD
205+
integer :: DUMMYI, DUMMYJ
206+
207+
integer :: COUNTS(3), DIMS(3)
208+
type(ESMF_DELayout) :: LAYOUT
209+
type(ESMF_DistGrid) :: DISTGRID
210+
real(ESMF_KIND_R8), allocatable :: x(:,:), y(:,:)
211+
real(ESMF_KIND_R8), pointer :: gridx(:,:), gridy(:,:)
201212

202213
_UNUSED_DUMMY(unusable)
214+
! get IM, JM and IM_WORLD, JM_WORLD
215+
call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, globalCellCountPerDim=DIMS, RC=STATUS)
216+
_VERIFY(STATUS)
217+
218+
IM = COUNTS(1)
219+
JM = COUNTS(2)
220+
IM_WORLD = DIMS(1)
221+
JM_WORLD = DIMS(2)
222+
223+
! get global index of the lower left corner
224+
!------------------------------------------
225+
call MAPL_GRID_INTERIOR(GRID,IMSTART,DUMMYI,JMSTART,DUMMYJ)
226+
227+
call ESMF_GridGetCoord(grid, localDE=0, coordDim=1, &
228+
staggerloc=ESMF_STAGGERLOC_CENTER, &
229+
farrayPtr=gridx, rc=status)
230+
_VERIFY(STATUS)
231+
232+
call ESMF_GridGetCoord(grid, localDE=0, coordDim=2, &
233+
staggerloc=ESMF_STAGGERLOC_CENTER, &
234+
farrayPtr=gridy, rc=status)
235+
_VERIFY(STATUS)
236+
237+
allocate(x(IM_WORLD, JM_WORLD), stat=status)
238+
_VERIFY(STATUS)
239+
allocate(y(IM_WORLD, JM_WORLD), stat=status)
240+
_VERIFY(STATUS)
241+
242+
call ESMF_GridGet (GRID, distGrid=distGrid, rc=STATUS)
243+
_VERIFY(STATUS)
244+
call ESMF_DistGridGet(distGRID, delayout=layout, rc=STATUS)
245+
_VERIFY(STATUS)
246+
247+
UNIT = GETFILE(this%grid_file_name, form="formatted", rc=status)
248+
call READ_PARALLEL(LAYOUT, X, unit=UNIT)
249+
call READ_PARALLEL(LAYOUT, Y, unit=UNIT)
250+
call FREE_FILE(UNIT)
251+
252+
253+
! Make sure the longitudes are between -180 and 180 degrees
254+
!ALT disable this for AR5 X = mod(X + 72180._8,360._8) - 180._8 ! -180<= lon0 <180
255+
! Convert to radians
256+
X = X * (MAPL_PI_R8)/180._8
257+
Y = Y * (MAPL_PI_R8)/180._8
258+
259+
260+
! Modify grid coordinates
261+
!------------------------
262+
GRIDX = X(IMSTART:IMSTART+IM-1,JMSTART:JMSTART+JM-1)
263+
GRIDY = Y(IMSTART:IMSTART+IM-1,JMSTART:JMSTART+JM-1)
264+
265+
! Clean-up
266+
!---------
267+
deallocate(y)
268+
deallocate(x)
203269

204-
call this%read_grid_coordinates(longitudes, latitudes)
205-
206-
call MAPL_grid_interior(grid, i_1, i_n, j_1, j_n)
207-
208-
! First we handle longitudes:
209-
call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, &
210-
staggerloc=ESMF_STAGGERLOC_CENTER, &
211-
farrayPtr=centers, rc=status)
212-
_VERIFY(status)
213-
214-
call ArrayScatter(centers, longitudes, grid, rc=status)
215-
_VERIFY(status)
216-
217-
! Now latitudes
218-
call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, &
219-
staggerloc=ESMF_STAGGERLOC_CENTER, &
220-
farrayPtr=centers, rc=status)
221-
_VERIFY(status)
222-
call ArrayScatter(centers, latitudes, grid, rc=status)
223-
_VERIFY(status)
224-
225-
deallocate(longitudes, latitudes)
226270
_RETURN(_SUCCESS)
227271

228272
end subroutine add_horz_coordinates
@@ -245,14 +289,15 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc
245289
call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT)
246290
this%grid_name = trim(tmp)
247291

248-
call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRID_FILE_NAME:', rc=status)
292+
call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDSPEC:', rc=status)
249293
_VERIFY(status)
250294
this%grid_file_name = trim(tmp)
251-
call this%read_grid_dimensions()
295+
!call this%read_grid_dimensions()
252296

253297
call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER)
254298
call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER)
255-
299+
call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER)
300+
call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=UNDEFINED_INTEGER)
256301
call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER)
257302

258303
call this%check_and_fill_consistency(rc=status)
@@ -324,7 +369,7 @@ subroutine check_and_fill_consistency(this, unusable, rc)
324369
integer, optional, intent(out) :: rc
325370

326371
character(len=*), parameter :: Iam = MOD_NAME // 'check_and_fill_consistency'
327-
372+
integer :: status
328373
_UNUSED_DUMMY(unusable)
329374

330375
if (.not. allocated(this%grid_name)) then
@@ -337,10 +382,51 @@ subroutine check_and_fill_consistency(this, unusable, rc)
337382
_ASSERT(mod(this%jm_world, this%ny) == 0)
338383

339384
! local extents
340-
this%ims = spread(this%im_world / this%nx, 1, this%nx)
341-
this%jms = spread(this%jm_world / this%ny, 1, this%ny)
385+
call verify(this%nx, this%im_world, this%ims, rc=status)
386+
call verify(this%ny, this%jm_world, this%jms, rc=status)
387+
!this%ims = spread(this%im_world / this%nx, 1, this%nx)
388+
!this%jms = spread(this%jm_world / this%ny, 1, this%ny)
342389

343390
_RETURN(_SUCCESS)
391+
392+
contains
393+
394+
subroutine verify(n, m_world, ms, rc)
395+
integer, intent(inout) :: n
396+
integer, intent(inout) :: m_world
397+
integer, allocatable, intent(inout) :: ms(:)
398+
integer, optional, intent(out) :: rc
399+
400+
integer :: status
401+
402+
if (allocated(ms)) then
403+
_ASSERT(size(ms) > 0)
404+
405+
if (n == UNDEFINED_INTEGER) then
406+
n = size(ms)
407+
else
408+
_ASSERT(n == size(ms))
409+
end if
410+
411+
if (m_world == UNDEFINED_INTEGER) then
412+
m_world = sum(ms)
413+
else
414+
_ASSERT(m_world == sum(ms))
415+
end if
416+
417+
else
418+
419+
_ASSERT(n /= UNDEFINED_INTEGER)
420+
_ASSERT(m_world /= UNDEFINED_INTEGER)
421+
allocate(ms(n), stat=status)
422+
_VERIFY(status)
423+
call MAPL_DecomposeDim(m_world, ms, n)
424+
425+
end if
426+
427+
_RETURN(_SUCCESS)
428+
429+
end subroutine verify
344430

345431
end subroutine check_and_fill_consistency
346432

@@ -444,66 +530,6 @@ function generate_grid_name(this) result(name)
444530
end function generate_grid_name
445531

446532

447-
subroutine read_grid_coordinates(this, longitudes, latitudes, unusable, rc)
448-
class (TripolarGridFactory), intent(in) :: this
449-
real(kind=REAL64), allocatable, intent(out) :: longitudes(:,:)
450-
real(kind=REAL64), allocatable, intent(out) :: latitudes(:,:)
451-
class (KeywordEnforcer), optional, intent(out) :: unusable
452-
integer, optional, intent(out) :: rc
453-
454-
include 'netcdf.inc'
455-
456-
integer :: status
457-
character(len=*), parameter :: Iam = MOD_NAME // 'read_grid_coordinates()'
458-
459-
integer :: xid, yid
460-
integer :: start(2), counts(2)
461-
integer :: pet, ndes
462-
logical :: i_am_root
463-
integer :: ncid
464-
type (ESMF_VM) :: vm
465-
466-
real(kind=REAL64), allocatable :: lons(:,:), lats(:,:)
467-
468-
_UNUSED_DUMMY(unusable)
469-
470-
call ESMF_VMGetCurrent(vm, rc=status)
471-
_VERIFY(status)
472-
473-
call ESMF_VMGet(vm, localpet=pet, petCount=ndes, rc=status)
474-
_VERIFY(status)
475-
476-
i_am_root = (pet == 0)
477-
478-
if (i_am_root) then
479-
allocate(longitudes(this%im_world, this%jm_world), stat=status)
480-
_VERIFY(status)
481-
allocate(latitudes(this%im_world, this%jm_world), stat=status)
482-
_VERIFY(status)
483-
484-
ncid = ncopn(this%grid_file_name, NCNOWRIT, status)
485-
_VERIFY(status)
486-
487-
xid = ncvid(ncid, 'x_T', status)
488-
_VERIFY(status)
489-
490-
yid = ncvid(ncid, 'y_T', status)
491-
_VERIFY(status)
492-
493-
call ncvgt(ncid, xid, start, counts, lons, status)
494-
_VERIFY(status)
495-
call ncvgt(ncid, yid, start, counts, lats, status)
496-
_VERIFY(status)
497-
498-
call ncclos(ncid, status)
499-
_VERIFY(status)
500-
else
501-
allocate(longitudes(0,0))
502-
allocate(latitudes(0,0))
503-
end if
504-
505-
end subroutine read_grid_coordinates
506-
507533
subroutine read_grid_dimensions(this, unusable, rc)
508534
use MAPL_CommsMod
509535
class (TripolarGridFactory), intent(inout) :: this

0 commit comments

Comments
 (0)