fix: unallocated variable access in test_mpp_nesting (#1336)

NOAA-GFDL · Aug 16, 2023 · 5326fd9 · 5326fd9
1 parent 01d73fb
commit 5326fd9
Showing 1 changed file with 8 additions and 6 deletions.
diff --git a/test_fms/mpp/test_mpp_nesting.F90 b/test_fms/mpp/test_mpp_nesting.F90
@@ -950,15 +950,15 @@ subroutine test_update_nest_domain_r8( type )
     !--- loop over nest level
     do l = 1, num_nest_level
        npes_my_level = mpp_get_nest_npes(nest_domain, l)
-       npes_my_fine = mpp_get_nest_fine_npes(nest_domain,l)
        allocate(my_pelist(npes_my_level))
-       allocate(my_pelist_fine(npes_my_fine))
        call mpp_get_nest_pelist(nest_domain, l, my_pelist)
 
        call mpp_declare_pelist(my_pelist(:))
        write(type2, '(a,I2)')trim(type)//" nest_level = ",l
        if(ANY(my_pelist(:)==mpp_pe())) then
 
+          npes_my_fine = mpp_get_nest_fine_npes(nest_domain,l)
+          allocate(my_pelist_fine(npes_my_fine))
           call mpp_get_nest_fine_pelist(nest_domain, l, my_pelist_fine)
 
           call mpp_set_current_pelist(my_pelist)
@@ -2625,7 +2625,8 @@ subroutine test_update_nest_domain_r8( type )
           deallocate(wbuffery2, ebuffery2, sbuffery2, nbuffery2)
        endif
        endif
-       deallocate(my_pelist, my_pelist_fine)
+       if(ANY(my_pelist(:)==mpp_pe())) deallocate(my_pelist_fine)
+       deallocate(my_pelist)
        call mpp_set_current_pelist()
 
     enddo
@@ -2984,15 +2985,15 @@ subroutine test_update_nest_domain_r4( type )
     !--- loop over nest level
     do l = 1, num_nest_level
        npes_my_level = mpp_get_nest_npes(nest_domain, l)
-       npes_my_fine = mpp_get_nest_fine_npes(nest_domain,l)
        allocate(my_pelist(npes_my_level))
-       allocate(my_pelist_fine(npes_my_fine))
        call mpp_get_nest_pelist(nest_domain, l, my_pelist)
 
        call mpp_declare_pelist(my_pelist(:))
        write(type2, '(a,I2)')trim(type)//" nest_level = ",l
        if(ANY(my_pelist(:) == mpp_pe())) then
 
+          npes_my_fine = mpp_get_nest_fine_npes(nest_domain,l)
+          allocate(my_pelist_fine(npes_my_fine))
           call mpp_get_nest_fine_pelist(nest_domain, l, my_pelist_fine)
 
           call mpp_set_current_pelist(my_pelist)
@@ -4655,7 +4656,8 @@ subroutine test_update_nest_domain_r4( type )
        endif
        endif
 
-       deallocate(my_pelist, my_pelist_fine)
+       if(ANY(my_pelist(:)==mpp_pe())) deallocate(my_pelist_fine)
+       deallocate(my_pelist)
        call mpp_set_current_pelist()
 
     enddo