From d529df8cf473cec234a4f5c1bb8d4cef3bf1f5a1 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 9 Apr 2020 17:21:27 -0700 Subject: [PATCH] Jedi DA modifications (#427) --- .../dynamics/ice_transport_driver.F90 | 4 +-- cicecore/cicedynB/general/ice_forcing.F90 | 12 +++---- cicecore/cicedynB/general/ice_forcing_bgc.F90 | 8 ++--- .../infrastructure/comm/mpi/ice_boundary.F90 | 14 ++++---- .../cicedynB/infrastructure/ice_blocks.F90 | 14 ++++---- .../cicedynB/infrastructure/ice_restoring.F90 | 4 +-- cicecore/shared/ice_distribution.F90 | 32 +++++++++++++++++-- cicecore/shared/ice_fileunits.F90 | 2 +- 8 files changed, 57 insertions(+), 33 deletions(-) diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index b3c72e8ca..7eaba64cf 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -44,11 +44,11 @@ module ice_transport_driver integer (kind=int_kind) :: & ntrace ! number of tracers in use - integer (kind=int_kind), dimension(:), allocatable :: & + integer (kind=int_kind), dimension(:), allocatable, public :: & tracer_type ,&! = 1, 2, or 3 (depends on 0, 1 or 2 other tracers) depend ! tracer dependencies (see below) - logical (kind=log_kind), dimension (:), allocatable :: & + logical (kind=log_kind), dimension (:), allocatable, public :: & has_dependents ! true if a tracer has dependent tracers integer (kind=int_kind), parameter :: & diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 2bbf72e11..64f4b4834 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -72,7 +72,7 @@ module ice_forcing sublim_file, & snow_file - character (char_len_long), dimension(:), allocatable :: & ! input data file names + character (char_len_long), dimension(:), allocatable, public :: & ! input data file names topmelt_file, & botmelt_file @@ -84,10 +84,10 @@ module ice_forcing oldrecnum = 0 , & ! old record number (save between steps) oldrecnum4X = 0 ! - real (kind=dbl_kind), dimension(:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & cldf ! cloud fraction - real (kind=dbl_kind), dimension(:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & fsw_data, & ! field values at 2 temporal data points cldf_data, & fsnow_data, & @@ -107,8 +107,7 @@ module ice_forcing sublim_data, & frain_data - real (kind=dbl_kind), & - dimension(:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:,:,:), allocatable, public :: & topmelt_data, & botmelt_data @@ -141,8 +140,7 @@ module ice_forcing frcidr = 0.31_dbl_kind, & ! frac of incoming sw in near IR direct band frcidf = 0.17_dbl_kind ! frac of incoming sw in near IR diffuse band - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & ocn_frc_m ! ocn data for 12 months logical (kind=log_kind), public :: & diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index 9d49e4349..4eedcfb80 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -35,11 +35,11 @@ module ice_forcing_bgc integer (kind=int_kind) :: & bgcrecnum = 0 ! old record number (save between steps) - real (kind=dbl_kind), dimension(:,:,:), allocatable :: & - nitdat , & ! data value toward which nitrate is restored - sildat ! data value toward which silicate is restored + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & + nitdat , & ! data value toward which nitrate is restored + sildat ! data value toward which silicate is restored - real (kind=dbl_kind), dimension(:,:,:,:), allocatable, save :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & nit_data, & ! field values at 2 temporal data points sil_data diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 3dce5a42e..884ee6331 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -100,19 +100,19 @@ module ice_boundary ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind), public :: & bufSizeSend, &! max buffer size for send messages bufSizeRecv ! max buffer size for recv messages - integer (int_kind), dimension(:,:), allocatable :: & + integer (int_kind), dimension(:,:), allocatable, public :: & bufSendI4, &! buffer for use to send in 2D i4 halo updates bufRecvI4 ! buffer for use to recv in 2D i4 halo updates - real (real_kind), dimension(:,:), allocatable :: & + real (real_kind), dimension(:,:), allocatable, public :: & bufSendR4, &! buffer for use to send in 2D r4 halo updates bufRecvR4 ! buffer for use to recv in 2D r4 halo updates - real (dbl_kind), dimension(:,:), allocatable :: & + real (dbl_kind), dimension(:,:), allocatable, public :: & bufSendR8, &! buffer for use to send in 2D r8 halo updates bufRecvR8 ! buffer for use to recv in 2D r8 halo updates @@ -122,13 +122,13 @@ module ice_boundary ! !----------------------------------------------------------------------- - integer (int_kind), dimension(:,:), allocatable :: & + integer (int_kind), dimension(:,:), allocatable, public :: & bufTripoleI4 - real (real_kind), dimension(:,:), allocatable :: & + real (real_kind), dimension(:,:), allocatable, public :: & bufTripoleR4 - real (dbl_kind), dimension(:,:), allocatable :: & + real (dbl_kind), dimension(:,:), allocatable, public :: & bufTripoleR8 !*********************************************************************** diff --git a/cicecore/cicedynB/infrastructure/ice_blocks.F90 b/cicecore/cicedynB/infrastructure/ice_blocks.F90 index b95ad6acb..5177dd047 100644 --- a/cicecore/cicedynB/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedynB/infrastructure/ice_blocks.F90 @@ -89,15 +89,15 @@ module ice_blocks ! !----------------------------------------------------------------------- - type (block), dimension(:), allocatable :: & + type (block), dimension(:), allocatable, public :: & all_blocks ! block information for all blocks in domain - integer (int_kind), dimension(:,:),allocatable :: & + integer (int_kind), dimension(:,:),allocatable, public :: & all_blocks_ij ! block index stored in Cartesian order ! useful for determining block index ! of neighbor blocks - integer (int_kind), dimension(:,:), allocatable, target :: & + integer (int_kind), dimension(:,:), allocatable, target, public :: & i_global, &! global i index for each point in each block j_global ! global j index for each point in each block @@ -157,10 +157,10 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & ! !---------------------------------------------------------------------- - allocate(all_blocks(nblocks_tot)) - allocate(i_global(nx_block,nblocks_tot), & - j_global(ny_block,nblocks_tot)) - allocate(all_blocks_ij(nblocks_x,nblocks_y)) + if (.not.allocated(all_blocks)) allocate(all_blocks(nblocks_tot)) + if (.not.allocated(i_global)) allocate(i_global(nx_block,nblocks_tot)) + if (.not.allocated(j_global)) allocate(j_global(ny_block,nblocks_tot)) + if (.not.allocated(all_blocks_ij)) allocate(all_blocks_ij(nblocks_x,nblocks_y)) !---------------------------------------------------------------------- ! diff --git a/cicecore/cicedynB/infrastructure/ice_restoring.F90 b/cicecore/cicedynB/infrastructure/ice_restoring.F90 index 1ef7b9531..09db9c273 100644 --- a/cicecore/cicedynB/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restoring.F90 @@ -32,12 +32,12 @@ module ice_restoring ! state of the ice for each category !----------------------------------------------------------------- - real (kind=dbl_kind), dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & aicen_rest , & ! concentration of ice vicen_rest , & ! volume per unit area of ice (m) vsnon_rest ! volume per unit area of snow (m) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & trcrn_rest ! tracers !======================================================================= diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 4af95ae1f..8c5808820 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -118,8 +118,7 @@ function create_distribution(dist_type, nprocs, work_per_block) case('spacecurve') - create_distribution = create_distrb_spacecurve(nprocs, & - work_per_block) + create_distribution = create_distrb_spacecurve(nprocs, work_per_block) case default @@ -364,7 +363,7 @@ subroutine ice_distributionDestroy(distribution) ! !---------------------------------------------------------------------- - distribution%nprocs = 0 + distribution%nprocs = 0 distribution%communicator = 0 distribution%numLocalBlocks = 0 @@ -377,6 +376,9 @@ subroutine ice_distributionDestroy(distribution) deallocate(distribution%blockLocation, stat=istat) deallocate(distribution%blockLocalID , stat=istat) deallocate(distribution%blockGlobalID, stat=istat) + deallocate(distribution%blockCnt , stat=istat) + deallocate(distribution%blockindex , stat=istat) + !----------------------------------------------------------------------- @@ -611,6 +613,12 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) return endif + allocate (newDistrb%blockCnt(nprocs)) + newDistrb%blockCnt(:) = 0 + + allocate(newDistrb%blockIndex(nprocs,max_blocks)) + newDistrb%blockIndex(:,:) = 0 + !---------------------------------------------------------------------- ! ! distribute blocks linearly across processors in each direction @@ -640,6 +648,8 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) localID = localID + 1 newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + newDistrb%blockIndex(processor,localID) = globalID else ! no work - eliminate block from distribution newDistrb%blockLocation(globalID) = 0 newDistrb%blockLocalID (globalID) = 0 @@ -966,6 +976,12 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) return endif + allocate (newDistrb%blockCnt(nprocs)) + newDistrb%blockCnt(:) = 0 + + allocate(newDistrb%blockIndex(nprocs,max_blocks)) + newDistrb%blockIndex(:,:) = 0 + allocate(procTmp(nprocs), stat=istat) if (istat > 0) then call abort_ice( & @@ -981,11 +997,13 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) if (pid > 0) then procTmp(pid) = procTmp(pid) + 1 newDistrb%blockLocalID (n) = procTmp(pid) + newDistrb%blockIndex(pid,procTmp(pid)) = n else newDistrb%blockLocalID (n) = 0 endif end do + newDistrb%blockCnt(:) = procTmp(:) newDistrb%numLocalBlocks = procTmp(my_task+1) if (minval(procTmp) < 1) then @@ -2146,6 +2164,12 @@ function create_distrb_spacecurve(nprocs,work_per_block) dist%blockLocation=0 dist%blockLocalID =0 + allocate (dist%blockCnt(nprocs)) + dist%blockCnt(:) = 0 + + allocate(dist%blockIndex(nprocs,max_blocks)) + dist%blockIndex(:,:) = 0 + !---------------------------------------------------------------------- ! Create the array to hold the SFC and indices into it !---------------------------------------------------------------------- @@ -2281,12 +2305,14 @@ function create_distrb_spacecurve(nprocs,work_per_block) if(pid>0) then proc_tmp(pid) = proc_tmp(pid) + 1 dist%blockLocalID(n) = proc_tmp(pid) + dist%blockIndex(pid,proc_tmp(pid)) = n else dist%blockLocalID(n) = 0 endif enddo dist%numLocalBlocks = proc_tmp(my_task+1) + dist%blockCnt(:) = proc_tmp(:) if (dist%numLocalBlocks > 0) then allocate (dist%blockGlobalID(dist%numLocalBlocks)) diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index cf67538aa..4c91fdb2a 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -108,7 +108,7 @@ subroutine init_fileunits character(len=*),parameter :: subname='(init_fileunits)' - allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit)) + if (.not.allocated(ice_IOUnitsInUse)) allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit)) ice_IOUnitsInUse = .false. ice_IOUnitsInUse(ice_stdin) = .true. ! reserve unit 5