Jedi DA modifications (#427)

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 ::                      &

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 :: &

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
 

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
 
 !***********************************************************************

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))
 
 !----------------------------------------------------------------------
 !

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
 
 !=======================================================================

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))

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