Merge branch 'develop' into feature/mathomp4/1930-profiler-output

CHANGELOG.md

@@ -36,6 +36,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Fixed
 
+- Changed the type of output counters to INT64 for large file. 
+- Tested optional arguments arrdes in MAPL_WriteVars
 - Added the correct values to halo corner of LatLon grid
 - Fixed range in halo of LatLonGridFactory
 - Corrected issue with native output having metadata saying it was bilinearly regridded. Now sets these files to have

base/NCIO.F90

@@ -614,7 +614,7 @@ subroutine MAPL_VarWriteNCpar_R4_4d(formatter, name, A, ARRDES, oClients, RC)
     type(Netcdf4_Fileformatter) , intent(IN   ) :: formatter
     character(len=*)            , intent(IN   ) :: name
     real(kind=ESMF_KIND_R4)     , intent(IN   ) :: A(:,:,:,:)
-    type(ArrDescr)              , intent(INOUT) :: ARRDES
+    type(ArrDescr), optional    , intent(INOUT) :: ARRDES
     type (ClientManager), optional, intent(inout)  :: oClients
     integer,           optional , intent(  OUT) :: RC
 
@@ -623,29 +623,39 @@ subroutine MAPL_VarWriteNCpar_R4_4d(formatter, name, A, ARRDES, oClients, RC)
     integer ::  i1, j1, in, jn,  global_dim(3)
     type(ArrayReference)     :: ref
 
-    if (arrdes%write_restart_by_oserver) then
-       _ASSERT(present(oClients), "output server is needed")
-       call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status)
-       _VERIFY(status)
-       call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn)
-       _ASSERT( i1 == arrdes%I1(arrdes%NX0), "interior starting i not match")
-       _ASSERT( j1 == arrdes%j1(arrdes%NY0), "interior starting j not match")
-       ref = ArrayReference(A)
-       _ASSERT( size(a,1) == in-i1+1, "size not match")
-       _ASSERT( size(a,2) == jn-j1+1, "size not match")
-       call oClients%collective_stage_data(arrdes%collection_id,trim(arrdes%filename),trim(name), &
-                   ref,start=[i1,j1,1,1], &
-                   global_start=[1,1,1,1], global_count=[global_dim(1),global_dim(2),size(a,3),size(a,4)])
+    if (present(arrdes)) then
+       if (arrdes%write_restart_by_oserver) then
+          _ASSERT(present(oClients), "output server is needed")
+          call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status)
+          _VERIFY(status)
+          call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn)
+          _ASSERT( i1 == arrdes%I1(arrdes%NX0), "interior starting i not match")
+          _ASSERT( j1 == arrdes%j1(arrdes%NY0), "interior starting j not match")
+          ref = ArrayReference(A)
+          _ASSERT( size(a,1) == in-i1+1, "size not match")
+          _ASSERT( size(a,2) == jn-j1+1, "size not match")
+          call oClients%collective_stage_data(arrdes%collection_id,trim(arrdes%filename),trim(name), &
+                      ref,start=[i1,j1,1,1], &
+                      global_start=[1,1,1,1], global_count=[global_dim(1),global_dim(2),size(a,3),size(a,4)])
+       else
+          do K = 1,size(A,4)
+             do L = 1,size(A,3)
+                call MAPL_VarWrite(formatter, name, A(:,:,L,K), arrdes=arrdes, &
+                     & oClients=oClients, lev=l, offset2=k, rc=status)
+                _VERIFY(status)
+             end do
+          end do
+       end if
     else
-
        do K = 1,size(A,4)
           do L = 1,size(A,3)
-             call MAPL_VarWrite(formatter, name, A(:,:,L,K), arrdes=arrdes, &
+             call MAPL_VarWrite(formatter, name, A(:,:,L,K), &
                   & oClients=oClients, lev=l, offset2=k, rc=status)
              _VERIFY(status)
           end do
-       end do
-    end if
+       enddo
+    endif
+
     _RETURN(ESMF_SUCCESS)
 
   end subroutine MAPL_VarWriteNCpar_R4_4d
@@ -706,22 +716,29 @@ subroutine MAPL_VarWriteNCpar_R4_3d(formatter, name, A, ARRDES, oClients, RC)
     integer ::  i1, j1, in, jn,  global_dim(3)
     type(ArrayReference)     :: ref
 
-    if (arrdes%write_restart_by_oserver) then
-       _ASSERT(present(oClients), "output server is needed")
-       call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status)
-       _VERIFY(status)
-       call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn)
-       _ASSERT( i1 == arrdes%I1(arrdes%NX0), "interior starting i not match")
-       _ASSERT( j1 == arrdes%j1(arrdes%NY0), "interior starting j not match")
-       ref = ArrayReference(A)
-       _ASSERT( size(a,1) == in-i1+1, "size not match")
-       _ASSERT( size(a,2) == jn-j1+1, "size not match")
-       call oClients%collective_stage_data(arrdes%collection_id,trim(arrdes%filename),trim(name), &
-                   ref,start=[i1,j1,1], &
-                   global_start=[1,1,1], global_count=[global_dim(1),global_dim(2),size(a,3)])
+    if (present(arrdes)) then
+       if (arrdes%write_restart_by_oserver) then
+          _ASSERT(present(oClients), "output server is needed")
+          call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status)
+          _VERIFY(status)
+          call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn)
+          _ASSERT( i1 == arrdes%I1(arrdes%NX0), "interior starting i not match")
+          _ASSERT( j1 == arrdes%j1(arrdes%NY0), "interior starting j not match")
+          ref = ArrayReference(A)
+          _ASSERT( size(a,1) == in-i1+1, "size not match")
+          _ASSERT( size(a,2) == jn-j1+1, "size not match")
+          call oClients%collective_stage_data(arrdes%collection_id,trim(arrdes%filename),trim(name), &
+                      ref,start=[i1,j1,1], &
+                      global_start=[1,1,1], global_count=[global_dim(1),global_dim(2),size(a,3)])
+       else
+          do l=1,size(a,3)
+             call MAPL_VarWrite(formatter,name,A(:,:,l), arrdes=arrdes,lev=l, rc=status)
+             _VERIFY(status)
+          enddo
+       endif
     else
        do l=1,size(a,3)
-          call MAPL_VarWrite(formatter,name,A(:,:,l), arrdes=arrdes,lev=l, rc=status)
+          call MAPL_VarWrite(formatter,name,A(:,:,l), lev=l, rc=status)
           _VERIFY(status)
        enddo
     endif

pfio/ForwardDataAndMessage.F90

@@ -56,7 +56,9 @@ subroutine serialize(this, buffer, rc)
       else
          buffer = buff_tmp
       endif
-
+      if ( size(buffer, kind=8) > huge(0)) then
+        _FAIL("need to increase oserver's number of front cores (nfront)")
+      endif
       _RETURN(_SUCCESS)
 
    end subroutine serialize

pfio/MessageVector.F90

@@ -27,9 +27,10 @@ module pFIO_MessageVectorUtilMod
 
 contains
 
-  subroutine serialize_message_vector(msgVec,buffer)
+  subroutine serialize_message_vector(msgVec,buffer, rc)
      type (MessageVector),intent(in) :: msgVec
      integer, allocatable,intent(inout) :: buffer(:)
+     integer, optional, intent(out) :: rc
      integer, allocatable :: tmp(:)
      class (AbstractMessage),pointer :: msg
      integer :: n, i
@@ -42,7 +43,13 @@ subroutine serialize_message_vector(msgVec,buffer)
         msg=>msgVec%at(i)
         tmp =[tmp, parser%encode(msg)]
      enddo
+
+     if(size(tmp, kind=8) > huge(0)) then
+       _FAIL("need to increase oserver's nfront")
+     endif
+
      i = size(tmp)+1
+
      if (allocated(buffer)) deallocate(buffer)
      buffer =[i,tmp]
 

pfio/MpiSocket.F90

@@ -156,10 +156,13 @@ function put(this, request_id, local_reference, rc) result(handle)
 
       integer, pointer :: data(:)
       integer :: n_words
+      integer(kind=INT64) :: big_n
 
       tag = make_tag(request_id)
 
-      n_words = product(local_reference%shape) * word_size(local_reference%type_kind)
+      big_n   = product(int(local_reference%shape, INT64)) * word_size(local_reference%type_kind)
+      _ASSERT( big_n < huge(0), "Increase the number of processors to decrease the local size of data to be sent")
+      n_words = big_n
       call c_f_pointer(local_reference%base_address, data, shape=[n_words])
       if (n_words ==0) allocate(data(1))
       call MPI_Isend(data, n_words, MPI_INTEGER, this%pair_remote_rank, tag, this%pair_comm, request, ierror)

pfio/MultiGroupServer.F90

@@ -597,8 +597,8 @@ subroutine start_back_writers(rc)
 
        integer, pointer :: g_1d(:), l_1d(:), g_2d(:,:), l_2d(:,:), g_3d(:,:,:), l_3d(:,:,:)
        integer, pointer :: g_4d(:,:,:,:), l_4d(:,:,:,:), g_5d(:,:,:,:,:), l_5d(:,:,:,:,:)
-       integer :: msize_word, d_rank, request_id
-       integer :: s0, e0, s1, e1, s2, e2, s3, e3, s4, e4, s5, e5
+       integer :: d_rank, request_id
+       integer(kind=INT64) :: msize_word, s0, e0, s1, e1, s2, e2, s3, e3, s4, e4, s5, e5
        type (StringAttributeMap) :: vars_map
        type (StringAttributeMapIterator) :: var_iter
        type (IntegerMessageMap) :: msg_map
@@ -607,6 +607,7 @@ subroutine start_back_writers(rc)
        class (*), pointer :: x_ptr(:)
        integer , allocatable :: buffer_v(:)
        type (Attribute), pointer :: attr_ptr
+       type (Attribute) :: attr_tmp
        type (c_ptr) :: address
        type (ForwardDataAndMessage), target :: f_d_m
        type (FileMetaData) :: fmd
@@ -664,11 +665,13 @@ subroutine start_back_writers(rc)
                type is (CollectiveStageDataMessage)
                   var_iter = vars_map%find(i_to_string(q%request_id))
                   if (var_iter == vars_map%end()) then
-                     msize_word = word_size(q%type_kind)*product(q%global_count)
+                     msize_word = word_size(q%type_kind)*product(int(q%global_count, INT64))
                      allocate(buffer_v(msize_word), source = -1)
-                     call vars_map%insert(i_to_string(q%request_id), Attribute(buffer_v))
-                     var_iter = vars_map%find(i_to_string(q%request_id))
+                     attr_tmp = Attribute(buffer_v)
                      deallocate(buffer_v)
+                     call vars_map%insert(i_to_string(q%request_id),attr_tmp)
+                     call attr_tmp%destroy() 
+                     var_iter = vars_map%find(i_to_string(q%request_id))
                      call msg_map%insert(q%request_id, q)
                   endif
                   attr_ptr => var_iter%value()

pfio/ServerThread.F90

@@ -824,16 +824,16 @@ subroutine put_DataToFile(this, message, address, rc)
       case (1:)
           select case (message%type_kind)
           case (pFIO_INT32)
-              call c_f_pointer(address, values_int32_1d, [product(count)])
+              call c_f_pointer(address, values_int32_1d, [product(int(count, INT64))])
               call formatter%put_var(message%var_name, values_int32_1d, start=start, count=count, _RC)
           case (pFIO_INT64)
-              call c_f_pointer(address, values_int64_1d, [product(count)])
+              call c_f_pointer(address, values_int64_1d, [product(int(count, INT64))])
               call formatter%put_var(message%var_name, values_int64_1d, start=start, count=count, _RC)
           case (pFIO_REAL32)
-              call c_f_pointer(address, values_real32_1d, [product(count)])
+              call c_f_pointer(address, values_real32_1d,[product(int(count, INT64))])
               call formatter%put_var(message%var_name, values_real32_1d, start=start, count=count, _RC)
           case (pFIO_REAL64)
-              call c_f_pointer(address, values_real64_1d, [product(count)])
+              call c_f_pointer(address, values_real64_1d,[product(int(count, INT64))])
               call formatter%put_var(message%var_name, values_real64_1d, start=start, count=count, _RC)
           case default
               _FAIL( "not supported type")

pfio/UnlimitedEntity.F90

@@ -55,6 +55,7 @@ module pFIO_UnlimitedEntityMod
       procedure :: serialize
       procedure :: get_string
       procedure :: is_empty
+      procedure :: destroy
    end type UnlimitedEntity
 
    ! This derived type is a workaround for sporadic Intel Fortran
@@ -253,6 +254,16 @@ subroutine set(this, value, rc)
       _RETURN(_SUCCESS)
    end subroutine set
 
+   subroutine destroy(this, rc)
+      class (UnlimitedEntity), intent(inout) :: this
+      integer, optional, intent(out) :: rc
+      if(allocated(this%value)) deallocate(this%value)
+      if(allocated(this%values)) deallocate(this%values)
+      if(allocated(this%shape)) deallocate(this%shape)
+      _RETURN(_SUCCESS)
+   end subroutine destroy
+
+   ! get string or scalar
    ! get string or scalar
    function get_value(this, rc) result(value)
       class (UnlimitedEntity), target, intent(in) :: this