Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

mixed precision: update mixedmode_base #1267

Merged
merged 30 commits into from
Jul 7, 2023
Merged

mixed precision: update mixedmode_base #1267

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
30 commits
Select commit Hold shift + click to select a range
485d631
fix: misspellings and rename variable in yaml_parser.F90 (#1127)
J-Lentz Feb 1, 2023
35a5f2a
fix: module and local variable name conflicts in time_interp (#1125)
mlee03 Feb 1, 2023
ba9c712
docs: Correct instructions to build without MPI (#1128)
J-Lentz Feb 1, 2023
15df841
fix: pointer to allocatable in amip_interp_type (#1106)
ganganoaa Feb 9, 2023
f0e8cab
feat: log_diag_field_info updates from diag rewrite (#1117)
rem1776 Feb 14, 2023
ec2020a
fix: remove implied save for valid_types variables in sat_vapor_pres_…
uramirez8707 Feb 16, 2023
4526cc9
revert: log_diag_field_info argument changes (#1136)
rem1776 Feb 16, 2023
6255971
feat: refactored send_data math (field buffer update) functions. (#1131)
ngs333 Feb 23, 2023
74d8e73
fix: adds tags to nested do loops in fms_diag_fieldbuff.fh to fix his…
ngs333 Feb 27, 2023
9b83c8c
fix - gnu and pgi issue with class(*) in send_data3d (#1149)
nikizadehgfdl Mar 9, 2023
9339b88
feat: extend `string` interface in `fms_string_utils_mod` (#1142)
J-Lentz Mar 9, 2023
0ff254e
fix: add omp directives for race condition in tridiagonal (#1109)
ganganoaa Mar 9, 2023
6362657
fix: missing if statement in PR #1149 (#1155)
nikizadehgfdl Mar 13, 2023
7188e3a
fix: time_manager missing changes from year to yr, month to mo, day t…
mlee03 Mar 28, 2023
8a78fac
chore: update changelog and version numbers for release (#1167)
rem1776 Apr 3, 2023
003b8e1
chore: append dev to version number post-release (#1179)
github-actions[bot] Apr 6, 2023
011b510
feat: merge 2023.01.01 changes into main (#1259)
rem1776 Jun 16, 2023
23b86db
feat: mixed precision for axis_utils2, horiz_interp, sat_vapor_pressu…
rem1776 Jun 16, 2023
af15993
fix: replace current_peset_num with 'n' which should be the active pe…
dkokron Jun 16, 2023
de03798
fix: gcc class(*) bug workaround for character arrays (#1163)
laurenchilutti Jun 16, 2023
16d71a2
fix: improve error messages in fms2_io (#1183)
uramirez8707 Jun 16, 2023
22c498e
feat: fms2_io unpack data (#1231)
uramirez8707 Jun 16, 2023
cf5035f
fix: improve doxygen comment for `tranlon` (#1257)
J-Lentz Jun 20, 2023
ecc1361
fix: ifort 2022.3.0 & greater ICE bug in alltoall test + missing inpu…
rem1776 Jun 20, 2023
783019f
fix: checks placed before allocating pointers passed into routines (#…
ganganoaa Jun 20, 2023
5e130ef
fix: continuation line syntax for fms2_io error messages (#1265)
J-Lentz Jun 27, 2023
66884b1
Merge remote-tracking branch 'origin/main' into mixedmode_base
Jun 28, 2023
3a0d2fc
forgot about fms
Jun 28, 2023
3926e31
remove test-lib.sh
Jun 28, 2023
4de4591
remove intel_coverage.sh
Jun 28, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 15 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,21 @@ and this project uses `yyyy.rr[.pp]`, where `yyyy` is the year a patch is releas
`rr` is a sequential release number (starting from `01`), and an optional two-digit
sequential patch number (starting from `01`).

## [2023.01.01] - 2023-06-06
### Changed
- FMS2_IO: Performance changes for domain_reads_2d and domain_reads_3d:
- Root pe reads the data
- Uses mpp_scatter to send the data to the other pes
- Added unit tests to test all of the domain_read/domain_write interfaces

- FMS2_IO: Performance changes for compressed_writes_1d/2d/3d
- Uses mpp_gather to get data for write
- Added unit tests to test all of the compressed writes interfaces
- Compressed_writes_4d/5d were unchanged

- FMS2_IO: Extended mpp_scatter and mpp_gather to work for int8; added a kludge for scatter since the data is assumed to be (x,y,z)


## [2023.01] - 2023-04-03
### Known Issues
- If using GCC 10 or higher as well as MPICH, compilation errors will occur unless `-fallow-argument-mismatch` is included in the Fortran compiler flags(the flag will now be added automatically if building with autotools or CMake).
Expand Down
5 changes: 4 additions & 1 deletion amip_interp/amip_interp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1353,7 +1353,10 @@ subroutine read_record (type, Date, Adate, dat)
else
call fms2_io_read_data(fileobj, ncfieldname, dat, unlim_dim_level=k)
endif
idat = nint(dat, I2_KIND) ! reconstruct packed data for reproducibility
!TODO This assumes that the data is "packed" (has the scale_factor and add_offset attributes)
! in fms2_io_read_data the data is unpacked (data_in_file*scale_factor + add_offset)
! the line below "packs" the data again. This is needed for reproducibility
idat = nint(dat*100., I2_KIND)

!---- unpacking of data ----

Expand Down
5 changes: 4 additions & 1 deletion amip_interp/include/amip_interp.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1353,7 +1353,10 @@ endif
else
call fms2_io_read_data(fileobj, ncfieldname, dat, unlim_dim_level=k)
endif
idat = nint(dat, I2_KIND) ! reconstruct packed data for reproducibility
!TODO This assumes that the data is "packed" (has the scale_factor and add_offset attributes)
! in fms2_io_read_data the data is unpacked (data_in_file*scale_factor + add_offset)
! the line below "packs" the data again. This is needed for reproducibility
idat = nint(dat*100., I2_KIND)

!---- unpacking of data ----

Expand Down
28 changes: 13 additions & 15 deletions axis_utils/include/axis_utils2.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

!***********************************************************************
!* GNU Lesser General Public License
!*
Expand Down Expand Up @@ -165,28 +164,27 @@

end function LON_IN_RANGE_

!> @brief Returns monotonic array of longitudes s.t., lon_strt <= lon(:) <= lon_strt+360.
!> @brief Returns monotonic array of longitudes s.t., lon_strt <= lon(:) < lon_strt+360.
!!
!! This may require that entries be moved from the beginning of the array to
!! the end. If no entries are moved (i.e., if lon(:) is already monotonic in
!! the range from lon_start to lon_start + 360), then istrt is set to 0. If
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

change lon_start to lon_strt for consistency

!! any entries are moved, then istrt is set to the original index of the entry
!! which becomes lon(1).
!!
!! e.g.,
!!
!> <br>The first istrt-1 entries are moved to the end of the array:
!! lon = 0 1 2 3 4 5 ... 358 359; lon_strt = 3
!! ==> lon = 3 4 5 6 7 8 ... 359 360 361 362; istrt = 4
!!
!! e.g.
!! lon = 0 1 2 3 4 5 ... 358 359; lon_strt = 3 ==>
!! tranlon = 3 4 5 6 7 8 ... 359 360 361 362; istrt = 4
!! lon = 0 1 2 3 4 5 ... 358 359; lon_strt = 0
!! ==> lon = 0 1 2 3 4 5 ... 358 359; istrt = 0

subroutine TRANLON_(lon, lon_start, istrt)

! returns array of longitudes s.t. lon_strt <= lon < lon_strt+360.
! also, the first istrt-1 entries are moved to the end of the array
!
! e.g.
! lon = 0 1 2 3 4 5 ... 358 359; lon_strt = 3 ==>
! tranlon = 3 4 5 6 7 8 ... 359 360 361 362; istrt = 4

real(kind=FMS_AU_KIND_), intent(inout), dimension(:) :: lon
real(kind=FMS_AU_KIND_), intent(in) :: lon_start
integer, intent(out) :: istrt


integer :: len, i
real(kind=FMS_AU_KIND_) :: lon_strt, tmp(size(lon(:))-1)

Expand Down
69 changes: 62 additions & 7 deletions exchange/include/xgrid.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1087,6 +1087,7 @@ logical, intent(in) :: use_higher_order
grid%x(1:size_prev) = x_local
deallocate(x_local)
else
if(ASSOCIATED(grid%x)) deallocate(grid%x) !< Check if allocated
allocate( grid%x( grid%size ) )
grid%x%di = 0.0; grid%x%dj = 0.0
end if
Expand Down Expand Up @@ -1248,6 +1249,7 @@ logical, intent(in) :: use_higher_order
grid%x_repro(1:ll_repro) = x_local
deallocate(x_local)
else
if(ASSOCIATED(grid%x_repro)) deallocate(grid%x_repro) !< Check if allocated
allocate( grid%x_repro( grid%size_repro ) )
grid%x_repro%di = 0.0; grid%x_repro%dj = 0.0
end if
Expand Down Expand Up @@ -1318,7 +1320,8 @@ subroutine get_grid_version1(grid, grid_id, grid_file)
endif

call mpp_get_compute_domain(grid%domain, is, ie, js, je)

if (associated(grid%lon)) deallocate(grid%lon) !< Check if allocated
if (associated(grid%lat)) deallocate(grid%lat) !< Check if allocated
allocate(grid%lon(grid%im), grid%lat(grid%jm))
if(grid_id == 'ATM') then
call read_data(fileobj, 'xta', lonb)
Expand Down Expand Up @@ -1413,6 +1416,8 @@ subroutine get_grid_version2(grid, grid_id, grid_file)
start(2) = 2; nread(1) = nlon*2+1
allocate(tmpx(nlon*2+1, 1), tmpy(1, nlat*2+1))
call read_data(fileobj, "x", tmpx, corner=start, edge_lengths=nread)
if (associated(grid%lon)) deallocate(grid%lon) !< Check if allocated
if (associated(grid%lat)) deallocate(grid%lat) !< Check if allocated
allocate(grid%lon(grid%im), grid%lat(grid%jm))
do i = 1, grid%im
grid%lon(i) = tmpx(2*i,1) * d2r
Expand All @@ -1425,6 +1430,8 @@ subroutine get_grid_version2(grid, grid_id, grid_file)
end do
grid%is_latlon = .true.
else
if (associated(grid%geolon)) deallocate(grid%geolon) !< Check if allocated
if (associated(grid%geolat)) deallocate(grid%geolat) !< Check if allocated
allocate(grid%geolon(grid%isd_me:grid%ied_me, grid%jsd_me:grid%jed_me))
allocate(grid%geolat(grid%isd_me:grid%ied_me, grid%jsd_me:grid%jed_me))
grid%geolon = 1e10
Expand Down Expand Up @@ -1545,8 +1552,12 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
xmap%npes = mpp_npes()
xmap%root_pe = mpp_root_pe()

if (associated(xmap%grids)) deallocate(xmap%grids) !< Check if allocated
allocate( xmap%grids(1:size(grid_ids(:))) )

if (associated(xmap%your1my2)) deallocate(xmap%your1my2) !< Check if allocated
if (associated(xmap%your2my1)) deallocate(xmap%your2my1) !< Check if allocated
if (associated(xmap%your2my1_size)) deallocate(xmap%your2my1_size) !< Check if allocated
allocate ( xmap%your1my2(0:xmap%npes-1), xmap%your2my1(0:xmap%npes-1) )
allocate ( xmap%your2my1_size(0:xmap%npes-1) )

Expand Down Expand Up @@ -1589,6 +1600,11 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
grid%id = grid_ids (g)
grid%domain = grid_domains(g)
grid%on_this_pe = mpp_domain_is_initialized(grid_domains(g))
if (associated(grid%is)) deallocate(grid%is) !< Check if allocated
if (associated(grid%ie)) deallocate(grid%ie) !< Check if allocated
if (associated(grid%js)) deallocate(grid%js) !< Check if allocated
if (associated(grid%je)) deallocate(grid%je) !< Check if allocated
if (associated(grid%tile)) deallocate(grid%tile) !< Check if allocated
allocate ( grid%is(0:xmap%npes-1), grid%ie(0:xmap%npes-1) )
allocate ( grid%js(0:xmap%npes-1), grid%je(0:xmap%npes-1) )
allocate ( grid%tile(0:xmap%npes-1) )
Expand Down Expand Up @@ -1679,6 +1695,10 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
'does not support unstructured grid for VERSION1 grid' ,FATAL)
grid%is_ug = .true.
grid%ug_domain = lnd_ug_domain
if (associated(grid%ls)) deallocate(grid%ls) !< Check if allocated
if (associated(grid%le)) deallocate(grid%le) !< Check if allocated
if (associated(grid%gs)) deallocate(grid%gs) !< Check if allocated
if (associated(grid%ge)) deallocate(grid%ge) !< Check if allocated
allocate ( grid%ls(0:xmap%npes-1), grid%le(0:xmap%npes-1) )
allocate ( grid%gs(0:xmap%npes-1), grid%ge(0:xmap%npes-1) )
grid%ls = 0
Expand All @@ -1695,6 +1715,7 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
grid%gs_me => grid%gs(xmap%me-xmap%root_pe); grid%ge_me => grid%ge(xmap%me-xmap%root_pe)
grid%tile_me => grid%tile(xmap%me-xmap%root_pe)
grid%nxl_me = grid%le_me - grid%ls_me + 1
if (associated(grid%l_index)) deallocate(grid%l_index) !< Check if allocated
allocate(grid%l_index(grid%gs_me:grid%ge_me))
allocate(grid_index(grid%ls_me:grid%le_me))
call mpp_get_UG_domain_grid_index(grid%ug_domain, grid_index)
Expand All @@ -1705,13 +1726,17 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
enddo

if( grid%on_this_pe ) then
if (associated(grid%area)) deallocate(grid%area) !< Check if allocated
if (associated(grid%area_inv)) deallocate(grid%area_inv) !< Check if allocated
allocate( grid%area (grid%ls_me:grid%le_me,1) )
allocate( grid%area_inv(grid%ls_me:grid%le_me,1) )
grid%area = 0.0
grid%size = 0
grid%size_repro = 0
endif
else if( grid%on_this_pe ) then
if (associated(grid%area)) deallocate(grid%area) !< Check if allocated
if (associated(grid%area_inv)) deallocate(grid%area_inv) !< Check if allocated
allocate( grid%area (grid%is_me:grid%ie_me, grid%js_me:grid%je_me) )
allocate( grid%area_inv(grid%is_me:grid%ie_me, grid%js_me:grid%je_me) )
grid%area = 0.0
Expand Down Expand Up @@ -1783,6 +1808,17 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
call error_mesg('xgrid_mod', 'incorrect dimension size of atm_grid%vlon', FATAL)
if(size(atm_grid%vlat,1) .NE. 3 .OR. size(atm_grid%vlat,2) .NE. nxc .OR. size(atm_grid%vlat,3) .NE. nyc)&
call error_mesg('xgrid_mod', 'incorrect dimension size of atm_grid%vlat', FATAL)
if (associated(grid%box%dx)) deallocate(grid%box%dx) !< Check if allocated
if (associated(grid%box%dy)) deallocate(grid%box%dy) !< Check if allocated
if (associated(grid%box%area)) deallocate(grid%box%area) !< Check if allocated
if (associated(grid%box%edge_w)) deallocate(grid%box%edge_w) !< Check if allocated
if (associated(grid%box%edge_e)) deallocate(grid%box%edge_e) !< Check if allocated
if (associated(grid%box%edge_s)) deallocate(grid%box%edge_s) !< Check if allocated
if (associated(grid%box%edge_n)) deallocate(grid%box%edge_n) !< Check if allocated
if (associated(grid%box%en1)) deallocate(grid%box%en1) !< Check if allocated
if (associated(grid%box%en2)) deallocate(grid%box%en2) !< Check if allocated
if (associated(grid%box%vlon)) deallocate(grid%box%vlon) !< Check if allocated
if (associated(grid%box%vlat)) deallocate(grid%box%vlat) !< Check if allocated
allocate(grid%box%dx (grid%is_me:grid%ie_me, grid%js_me:grid%je_me+1 ))
allocate(grid%box%dy (grid%is_me:grid%ie_me+1, grid%js_me:grid%je_me ))
allocate(grid%box%area (grid%is_me:grid%ie_me, grid%js_me:grid%je_me ))
Expand Down Expand Up @@ -1811,6 +1847,7 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
if(xmap%version==VERSION2) call close_file(mosaicfileobj)
if (g>1) then
if(grid%on_this_pe) then
if (associated(grid%frac_area)) deallocate(grid%frac_area) !< Check if allocated
if(grid%is_ug) then
allocate( grid%frac_area(grid%ls_me:grid%le_me, 1, grid%km) )
else
Expand Down Expand Up @@ -1939,6 +1976,8 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
xmap%your2my1(xmap%me-xmap%root_pe) = .false. ! a PE from communicating with itself

if (make_exchange_reproduce) then
if (associated(xmap%send_count_repro)) deallocate(xmap%send_count_repro) !< Check if allocated
if (associated(xmap%recv_count_repro)) deallocate(xmap%recv_count_repro) !< Check if allocated
allocate( xmap%send_count_repro(0:xmap%npes-1) )
allocate( xmap%recv_count_repro(0:xmap%npes-1) )
xmap%send_count_repro = 0
Expand All @@ -1960,12 +1999,18 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
xmap%recv_count_repro_tot = 0
end if

if (associated(xmap%x1)) deallocate(xmap%x1) !< Check if allocated
if (associated(xmap%x2)) deallocate(xmap%x2) !< Check if allocated
if (associated(xmap%x1_put)) deallocate(xmap%x1_put) !< Check if allocated
if (associated(xmap%x2_get)) deallocate(xmap%x2_get) !< Check if allocated
allocate( xmap%x1(1:sum(xmap%grids(2:size(xmap%grids(:)))%size)) )
allocate( xmap%x2(1:sum(xmap%grids(2:size(xmap%grids(:)))%size)) )
allocate( xmap%x1_put(1:sum(xmap%grids(2:size(xmap%grids(:)))%size)) )
allocate( xmap%x2_get(1:sum(xmap%grids(2:size(xmap%grids(:)))%size)) )

!--- The following will setup indx to be used in regen
if (associated(xmap%get1)) deallocate(xmap%get1) !< Check if allocated
if (associated(xmap%put1)) deallocate(xmap%put1) !< Check if allocated
allocate(xmap%get1, xmap%put1)
call mpp_clock_begin(id_set_comm)

Expand All @@ -1974,6 +2019,7 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_
call set_comm_put1(xmap)

if(make_exchange_reproduce) then
if (associated(xmap%get1_repro)) deallocate(xmap%get1_repro) !< Check if allocated
allocate(xmap%get1_repro)
call set_comm_get1_repro(xmap)
endif
Expand Down Expand Up @@ -2174,6 +2220,7 @@ subroutine set_comm_get1_repro(xmap)

comm%nrecv = nrecv
if( nrecv > 0 ) then
if (associated(comm%recv)) deallocate(comm%recv) !< Check if allocated
allocate(comm%recv(nrecv))
pos = 0
do n = 1, nrecv
Expand All @@ -2200,6 +2247,7 @@ subroutine set_comm_get1_repro(xmap)

comm%nsend = nsend
if( nsend > 0 ) then
if (associated(comm%send)) deallocate(comm%send) !< Check if allocated
allocate(comm%send(nsend))
pos = 0
cnt(:) = 0
Expand Down Expand Up @@ -2296,6 +2344,7 @@ subroutine set_comm_get1(xmap)

if(max_size > 0) then
allocate(pe_side1(max_size))
if (associated(xmap%ind_get1)) deallocate(xmap%ind_get1) !< Check if allocated
allocate(xmap%ind_get1(max_size))

!--- find the recv_indx
Expand Down Expand Up @@ -2399,6 +2448,7 @@ subroutine set_comm_get1(xmap)
nsend = count( send_size> 0)
comm%nsend = nsend
if(nsend>0) then
if (associated(comm%send)) deallocate(comm%send) !< Check if allocated
allocate(comm%send(nsend))
comm%send(:)%count = 0
endif
Expand Down Expand Up @@ -2474,6 +2524,7 @@ subroutine set_comm_get1(xmap)
comm%recvsize = 0

if(nrecv >0) then
if (associated(comm%recv)) deallocate(comm%recv) !< Check if allocated
allocate(comm%recv(nrecv))
comm%recv(:)%count = 0
!--- set up the buffer pos for each receiving
Expand Down Expand Up @@ -2526,6 +2577,7 @@ subroutine set_comm_get1(xmap)
endif
endif
enddo
if (associated(comm%unpack_ind)) deallocate(comm%unpack_ind) !< Check if allocated
allocate(comm%unpack_ind(nrecv))
pos = 0
do p = 0, npes-1
Expand Down Expand Up @@ -2604,6 +2656,7 @@ subroutine set_comm_put1(xmap)

if(max_size > 0) then
allocate(pe_put1(max_size))
if (associated(xmap%ind_put1)) deallocate(xmap%ind_put1) !< Check if allocated
allocate(xmap%ind_put1(max_size))

!--- find the recv_indx
Expand Down Expand Up @@ -2724,6 +2777,7 @@ subroutine set_comm_put1(xmap)
nrecv = count( send_size> 0)
comm%nrecv = nrecv
if(nrecv>0) then
if (associated(comm%recv)) deallocate(comm%recv) !< Check if allocated
allocate(comm%recv(nrecv))
comm%recv(:)%count = 0
endif
Expand Down Expand Up @@ -2798,6 +2852,7 @@ subroutine set_comm_put1(xmap)
comm%sendsize = 0

if(nsend >0) then
if (associated(comm%send)) deallocate(comm%send) !< Check if allocated
allocate(comm%send(nsend))
comm%send(:)%count = 0
pos = 0
Expand Down Expand Up @@ -2864,8 +2919,8 @@ type (xmap_type), intent(inout) :: xmap
end do

if (max_size>size(xmap%x1(:))) then
deallocate(xmap%x1)
deallocate(xmap%x2)
if (associated(xmap%x1)) deallocate(xmap%x1) !< Check x1 if allocated
if (associated(xmap%x2)) deallocate(xmap%x2) !< Check x2 if allocated
allocate( xmap%x1(1:max_size) )
allocate( xmap%x2(1:max_size) )
endif
Expand Down Expand Up @@ -2933,11 +2988,11 @@ type (xmap_type), intent(inout) :: xmap


if (max_size>size(xmap%x1_put(:))) then
deallocate(xmap%x1_put)
if (associated(xmap%x1_put)) deallocate(xmap%x1_put) !< Check if allocated
allocate( xmap%x1_put(1:max_size) )
endif
if (max_size>size(xmap%x2_get(:))) then
deallocate(xmap%x2_get)
if (associated(xmap%x2_get)) deallocate(xmap%x2_get) !< Check if allocated
allocate( xmap%x2_get(1:max_size) )
endif

Expand Down Expand Up @@ -3067,7 +3122,7 @@ type (xmap_type), intent(inout) :: xmap !< exchange grid with given grid I
grid => xmap%grids(g)
if (grid_id==grid%id) then
if (size(f,3)/=size(grid%frac_area,3)) then
deallocate (grid%frac_area)
if (associated(grid%frac_area)) deallocate (grid%frac_area) !< Check if allocated
grid%km = size(f,3);
allocate( grid%frac_area(grid%is_me:grid%ie_me, grid%js_me:grid%je_me, &
grid%km) )
Expand Down Expand Up @@ -3101,7 +3156,7 @@ type (xmap_type), intent(inout) :: xmap !< exchange grid with given grid I
grid => xmap%grids(g)
if (grid_id==grid%id) then
if (size(f,2)/=size(grid%frac_area,3)) then
deallocate (grid%frac_area)
if (associated(grid%frac_area)) deallocate (grid%frac_area) !< Check if allocated
grid%km = size(f,2);
allocate( grid%frac_area(grid%ls_me:grid%le_me, 1, grid%km) )
end if
Expand Down
Loading