Cryptic soil layer indexing bug

src/core_atmosphere/physics/Registry_noahmp.xml

@@ -16,7 +16,7 @@
       <dim name="nSnowLevels" definition="3"
                 description="The number of snow layers used by the NOAHMP land-surface scheme"/>
 
-      <dim name="nzSnowLevels" definition="7"
+      <dim name="nzSnowLevels" definition="nSoilLevels+nSnowLevels"
                 description="The number of snow layer depths used by the NOAHMP land-surface scheme"/>
 
  </dims>

src/core_atmosphere/physics/mpas_atmphys_driver_lsm_noahmp.F

@@ -842,14 +842,10 @@ subroutine lsm_noahmp_toMPAS(diag_physics,diag_physics_noahmp,output_noahmp,sfc_
        snicexy(ns,i) = mpas_noahmp%snicexy(i,n)
        snliqxy(ns,i) = mpas_noahmp%snliqxy(i,n)
     enddo
-    do ns = 1,nsnow
+    do ns = 1,nzsnow
        n = ns - nsnow
        zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n)
     enddo
-    do ns = nsnow+1,nzsnow
-       n = ns - nsoil + 1
-       zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n)
-    enddo
  enddo
 
 

src/core_init_atmosphere/Registry.xml

@@ -385,7 +385,7 @@
                 <package name="met_stage_in" description="Active only if meteorological fields are being interpolated"/>
                 <package name="met_stage_out" description="Active only if meteorological fields are being interpolated"/>
                 <package name="first_guess_field" description="3-d atmospheric or land-surface fields on first-guess levels"/>
-                <package name="mp_thompson_aers_in" description="initialization of GOCART-based Thompson water- and ice-friendly aerosols"/>
+                <package name="microphysics_aerosols" description="Initialization of GOCART-based water- and ice-friendly aerosols for Thompson and TEMPO microphysics"/>
                 <package name="noahmp" description="Whether to process, read, and write static fields only required by Noah-MP"/>
         </packages>
 
@@ -599,7 +599,7 @@
                         <var name="v_init" packages="met_stage_out"/>
                         <var name="t_init" packages="met_stage_out"/>
                         <var name="qv_init" packages="met_stage_out"/>
-                        <var_array name="scalars" packages="met_stage_out;mp_thompson_aers_in"/>
+                        <var_array name="scalars" packages="met_stage_out;microphysics_aerosols"/>
                         <var name="u" packages="met_stage_out"/>
                         <var name="w" packages="met_stage_out"/>
                         <var name="dz" packages="met_stage_out"/>
@@ -1025,15 +1025,15 @@
                 <!-- GOCART aerosol fields -->
                 <var name="nifa_gocart_clim" type="real" dimensions="nMonths nGocartLevels nCells" units="nb kg^{-1}"
                      description="climatological Gocart ice-friendly number concentration"
-                     packages="mp_thompson_aers_in"/>
+                     packages="microphysics_aerosols"/>
 
                 <var name="nwfa_gocart_clim" type="real" dimensions="nMonths nGocartLevels nCells" units="nb kg^{-1}"
                      description="climatological Gocart water-friendly number concentration"
-                     packages="mp_thompson_aers_in"/>
+                     packages="microphysics_aerosols"/>
 
                 <var name="pwif_gocart_clim" type="real"  dimensions="nMonths nGocartLevels nCells" units="Pa"
                      description="climatological Gocart pressure levels"
-                     packages="mp_thompson_aers_in"/>
+                     packages="microphysics_aerosols"/>
 
                 <!-- description of the vertical grid structure -->
                 <var name="hx" type="real" dimensions="nVertLevelsP1 nCells" units="m"
@@ -1166,11 +1166,12 @@
 
                         <var name="nifa" array_group="number" units="nb kg^{-1}"
                              description="Gocart ice-friendly aerosol number concentration"
-                             packages="mp_thompson_aers_in"/>
+                             packages="microphysics_aerosols"/>
 
                         <var name="nwfa" array_group="number" units="nb kg^{-1}"
                              description="Gocart water-friendly aerosol number concentration"
-                             packages="mp_thompson_aers_in"/>
+                             packages="microphysics_aerosols"/>
+
                         <var name="tke" array_group="turbulence" units="m^2 s^{-2}"
                              description="Turbulent kinetic energy for the prognostic tke LES scheme"/>
                 </var_array>
@@ -1210,11 +1211,11 @@
 
                         <var name="lbc_nifa" array_group="number" units="nb kg^{-1}"
                              description="Gocart ice-friendly aerosol number concentration on lateral boundary cells"
-                             packages="mp_thompson_aers_in"/>
+                             packages="microphysics_aerosols"/>
 
                         <var name="lbc_nwfa" array_group="number" units="nb kg^{-1}"
                              description="Gocart water-friendly aerosol number concentration on lateral boundary cells"
-                             packages="mp_thompson_aers_in"/>
+                             packages="microphysics_aerosols"/>
                 </var_array>
 
         </var_struct>

src/core_init_atmosphere/mpas_init_atm_core_interface.F

@@ -120,7 +120,7 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
       logical, pointer :: config_native_gwd_static, config_static_interp, config_vertical_grid, config_met_interp
       logical, pointer :: config_native_gwd_gsl_static
       logical, pointer :: first_guess_field
-      logical, pointer :: mp_thompson_aers_in
+      logical, pointer :: microphysics_aerosols
       integer, pointer :: config_init_case
       logical, pointer :: noahmp, config_noahmp_static
 
@@ -167,8 +167,8 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
       nullify(met_stage_out)
       call mpas_pool_get_package(packages, 'met_stage_outActive', met_stage_out)
 
-      nullify(mp_thompson_aers_in)
-      call mpas_pool_get_package(packages, 'mp_thompson_aers_inActive', mp_thompson_aers_in)
+      nullify(microphysics_aerosols)
+      call mpas_pool_get_package(packages, 'microphysics_aerosolsActive', microphysics_aerosols)
 
       if (.not. associated(initial_conds) .or. &
           .not. associated(sfc_update) .or. &
@@ -179,7 +179,7 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
           .not. associated(vertical_stage_out) .or. &
           .not. associated(met_stage_in) .or. &
           .not. associated(met_stage_out) .or. &
-          .not. associated(mp_thompson_aers_in)) then
+          .not. associated(microphysics_aerosols)) then
          call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR)
          call mpas_log_write('* Error while setting up packages for init_atmosphere core.',                      messageType=MPAS_LOG_ERR)
          call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR)
@@ -197,12 +197,12 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
 
       if (config_init_case == 9) then
          lbcs = .true.
-         mp_thompson_aers_in = .false.
+         microphysics_aerosols = .false.
          inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist)
-         if(lexist) mp_thompson_aers_in = .true.
+         if(lexist) microphysics_aerosols = .true.
       else
          lbcs = .false.
-         mp_thompson_aers_in = .false.
+         microphysics_aerosols = .false.
       end if
 
       if (config_init_case == 7) then
@@ -226,9 +226,9 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
                         (.not. config_vertical_grid)
          met_stage_out = config_met_interp
 
-         mp_thompson_aers_in = .false.
+         microphysics_aerosols = .false.
          inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist)
-         if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) mp_thompson_aers_in = .true.
+         if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) microphysics_aerosols = .true.
 
       else if (config_init_case == 8) then
          gwd_stage_in = .false.
@@ -252,9 +252,9 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul
          met_stage_in = .true.
          met_stage_out = .true.
 
-         mp_thompson_aers_in = .false.
+         microphysics_aerosols = .false.
          inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist)
-         if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) mp_thompson_aers_in = .true.
+         if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) microphysics_aerosols = .true.
 
          initial_conds = .false.   ! Also, turn off the initial_conds package to avoid writing the IC "output" stream
 

src/core_init_atmosphere/mpas_init_atm_read_met.F

@@ -25,17 +25,37 @@ module init_atm_read_met
 
    ! Derived types
    type met_data
-      integer                       :: version, nx, ny, iproj
-      real (kind=real32)                 :: xfcst, xlvl, startlat, startlon, starti, startj, &
-                                       deltalat, deltalon, dx, dy, xlonc, &
-                                       truelat1, truelat2, earth_radius
-      real (kind=real32), pointer, dimension(:,:) :: slab
-      logical                       :: is_wind_grid_rel
-      character (len=9)             :: field
-      character (len=24)            :: hdate
-      character (len=25)            :: units
-      character (len=32)            :: map_source
-      character (len=46)            :: desc
+      integer :: version = 5, &         ! Format version (must =5 for WPS format)
+                 nx      = 0, &         ! First (x) dimension of 2-d array 'slab'
+                 ny      = 0, &         ! Second (y) dimension of 2-d array 'slab'
+                 iproj   = PROJ_LATLON  ! Code for projection of data in array
+
+      real (kind=real32) :: xfcst        = 0.0_real32, &  ! Forecast hour of data
+                            xlvl         = 0.0_real32, &  ! Vertical level of data in 2-d array 'slab'
+                            startlat     = 0.0_real32, &  ! Latitude of starting point (degrees)
+                            startlon     = 0.0_real32, &  ! Longitude of starting point (degrees)
+                            starti       = 1.0_real32, &  ! Starting x-/i-index
+                            startj       = 1.0_real32, &  ! Starting y-/j-index
+                            deltalat     = 0.0_real32, &  ! Grid spacing (degrees) in meridional direction
+                            deltalon     = 0.0_real32, &  ! Grid spacing (degrees) in zonal direction
+                            dx           = 0.0_real32, &  ! Grid spacing (km) in x-direction
+                            dy           = 0.0_real32, &  ! Grid spacing (km) in y-direction
+                            xlonc        = 0.0_real32, &  ! Standard longitude of projection
+                            truelat1     = 0.0_real32, &  ! First true latitude of projection
+                            truelat2     = 0.0_real32, &  ! Second true latitude of projection
+                            earth_radius = EARTH_RADIUS_M / 1000.0_real32  ! Earth radius (km)
+
+      real (kind=real32), pointer, dimension(:,:) :: slab => null()  ! 2-d array of data
+
+      logical :: is_wind_grid_rel = .false.  ! Flag indicating whether winds are
+                                             !       relative to source grid (.true.) or
+                                             !       relative to earth (.false.)
+
+      character (len=9)  :: field      = ''  ! Name of the field
+      character (len=24) :: hdate      = ''  ! Valid date for data YYYY:MM:DD_HH:mm:ss
+      character (len=25) :: units      = ''  ! Units of data
+      character (len=32) :: map_source = ''  !  Source model / originating center
+      character (len=46) :: desc       = ''  ! Short description of data
    end type met_data
 
 

src/external/ezxml/ezxml.c

@@ -481,6 +481,7 @@ ezxml_t ezxml_parse_str(char *s, size_t len)
     int l, i, j;
 
     root->m = s;
+    root->len = -1; // so we know to free s in ezxml_free()
     if (! len) return ezxml_err(root, NULL, "root tag missing");
     root->u = ezxml_str2utf8(&s, &len); // convert utf-16 to utf-8
     root->e = (root->s = s) + len; // record start and end of work area

src/framework/mpas_block_creator.F

@@ -249,6 +249,8 @@ subroutine mpas_block_creator_build_0halo_cell_fields(nHalos, indexToCellIDBlock
      call mpas_dmpar_alltoall_field(cellsOnCellBlock, cellsOnCell_0Halo, sendingHaloLayers)
      call mpas_dmpar_alltoall_field(verticesOnCellBlock, verticesOnCell_0Halo, sendingHaloLayers)
      call mpas_dmpar_alltoall_field(edgesOnCellBlock, edgesOnCell_0Halo, sendingHaloLayers)
+
+     deallocate(sendingHaloLayers)
    end subroutine mpas_block_creator_build_0halo_cell_fields!}}}
 
 !***********************************************************************

src/framework/mpas_domain_routines.F

@@ -46,10 +46,7 @@ subroutine mpas_allocate_domain(dom)!{{{
       allocate(dom % dminfo)
       nullify(dom % blocklist)
 
-      allocate(dom % configs)
-      allocate(dom % packages)
       allocate(dom % clock)
-      allocate(dom % streamManager)
       allocate(dom % ioContext)
 
       call mpas_pool_create_pool(dom % configs)
@@ -87,9 +84,6 @@ subroutine mpas_allocate_block(nHaloLayers, b, dom, blockID) !{{{
 
       b % domain => dom
 
-      allocate(b % structs)
-      allocate(b % dimensions)
-      allocate(b % allFields)
       call mpas_pool_create_pool(b % structs)
       call mpas_pool_create_pool(b % dimensions)
       call mpas_pool_create_pool(b % allFields)
@@ -138,6 +132,8 @@ subroutine mpas_deallocate_domain(dom)!{{{
       deallocate(dom % clock)
       deallocate(dom % ioContext)
 
+      deallocate(dom % dminfo)
+
    end subroutine mpas_deallocate_domain!}}}
 
 
@@ -167,17 +163,17 @@ subroutine mpas_deallocate_block(b)!{{{
       call mpas_pool_destroy_pool(b % structs)
       call mpas_pool_destroy_pool(b % dimensions)
 
-      deallocate(b % parinfo % cellsToSend)
-      deallocate(b % parinfo % cellsToRecv)
-      deallocate(b % parinfo % cellsToCopy)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % cellsToSend)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % cellsToRecv)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % cellsToCopy)
 
-      deallocate(b % parinfo % edgesToSend)
-      deallocate(b % parinfo % edgesToRecv)
-      deallocate(b % parinfo % edgesToCopy)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % edgesToSend)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % edgesToRecv)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % edgesToCopy)
 
-      deallocate(b % parinfo % verticesToSend)
-      deallocate(b % parinfo % verticesToRecv)
-      deallocate(b % parinfo % verticesToCopy)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % verticesToSend)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % verticesToRecv)
+      call mpas_dmpar_destroy_mulithalo_exchange_list(b % parinfo % verticesToCopy)
 
       deallocate(b % parinfo)
 

src/framework/mpas_framework.F

@@ -65,7 +65,6 @@ subroutine mpas_framework_init_phase1(dminfo, external_comm)!{{{
       integer, intent(in), optional :: external_comm
 #endif
 
-      allocate(dminfo)
       call mpas_dmpar_init(dminfo, external_comm)
 
    end subroutine mpas_framework_init_phase1!}}}
@@ -182,14 +181,14 @@ subroutine mpas_framework_finalize(dminfo, domain, io_system)!{{{
 
       call MPAS_io_finalize(domain % ioContext, .false.)
 
-      call mpas_deallocate_domain(domain)
-
       call mpas_dmpar_finalize(dminfo)
 
       call mpas_finish_block_proc_list(dminfo)
 
       call mpas_timekeeping_finalize()
 
+      call mpas_deallocate_domain(domain)
+
    end subroutine mpas_framework_finalize!}}}
 
 

src/framework/mpas_io.F

@@ -210,7 +210,6 @@ subroutine MPAS_io_init(ioContext, io_task_count, io_task_stride, io_system, ier
 #endif
 
 #ifdef MPAS_SMIOL_SUPPORT
-         allocate(ioContext % smiol_context)
 #ifdef MPAS_USE_MPI_F08
          local_ierr = SMIOLf_init(ioContext % dminfo % comm % mpi_val, &
 #else
@@ -1256,6 +1255,7 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie
             ! TODO: Can we get the dimension sizes to see whether they match those from the file?
 
          end if
+         if (associated(inq_dimnames)) deallocate(inq_dimnames)
 
          return
       end if
@@ -6335,13 +6335,15 @@ subroutine MPAS_io_close(handle, ierr)
             if (attlist_del % atthandle % attType == MPAS_ATT_INTA) deallocate(attlist_del % atthandle % attValueIntA)
             if (attlist_del % atthandle % attType == MPAS_ATT_REALA) deallocate(attlist_del % atthandle % attValueRealA)
             deallocate(attlist_del % atthandle)
+            deallocate(attlist_del)
          end do
          nullify(fieldlist_del % fieldhandle % attlist_head)
          nullify(fieldlist_del % fieldhandle % attlist_tail)
 
          deallocate(fieldlist_del % fieldhandle % dims)
 
          deallocate(fieldlist_del % fieldhandle)
+         deallocate(fieldlist_del)
       end do
       nullify(handle % fieldlist_head)
       nullify(handle % fieldlist_tail)
@@ -6351,6 +6353,7 @@ subroutine MPAS_io_close(handle, ierr)
          dimlist_del => dimlist_ptr 
          dimlist_ptr => dimlist_ptr % next
          deallocate(dimlist_del % dimhandle)
+         deallocate(dimlist_del)
       end do
       nullify(handle % dimlist_head)
       nullify(handle % dimlist_tail)
@@ -6362,6 +6365,7 @@ subroutine MPAS_io_close(handle, ierr)
          if (attlist_del % atthandle % attType == MPAS_ATT_INTA) deallocate(attlist_del % atthandle % attValueIntA)
          if (attlist_del % atthandle % attType == MPAS_ATT_REALA) deallocate(attlist_del % atthandle % attValueRealA)
          deallocate(attlist_del % atthandle)
+         deallocate(attlist_del)
       end do
       nullify(handle % attlist_head)
       nullify(handle % attlist_tail)

src/framework/mpas_pool_routines.F

@@ -229,6 +229,14 @@ recursive subroutine mpas_pool_destroy_pool(inPool)!{{{
                      deallocate(ptr % data % simple_int)
                   end if
 
+               else if (ptr % contentsType == MPAS_POOL_PACKAGE) then
+
+                  dptr => ptr % data
+
+                  if (dptr % contentsType == MPAS_POOL_LOGICAL) then
+                     deallocate(dptr % simple_logical)
+                  end if
+
                else if (ptr % contentsType == MPAS_POOL_CONFIG) then
 
                   dptr => ptr % data
@@ -5795,6 +5803,7 @@ logical function pool_remove_member(inPool, key, memType)!{{{
                      end if
 
 !TODO: are there cases where we need to delete more data here?
+                     if (associated(ptr_prev % data)) deallocate(ptr_prev % data)
                      deallocate(ptr_prev)
                   end if
                   pool_remove_member = .true.
@@ -5828,6 +5837,7 @@ logical function pool_remove_member(inPool, key, memType)!{{{
                         end if
 
 !TODO: are there cases where we need to delete more data here?
+                        if (associated(ptr % data)) deallocate(ptr % data)
                         deallocate(ptr)
                      end if
                      pool_remove_member = .true.